procedure TForm1.Button1Click(Sender: T);
const CLAVE =
"\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall";
var
reg : TRegistry;
Lista : TStringList;
Lista2 : TStringList;
i,n : integer;
begin
{Create temporal things}
reg := TRegistry.Create;
Lista := TStringList.Create;
Lista2 := TStringList.Create;
{Load all the subkeys}
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(CLAVE,false);
GetKeyNames(Lista);
end;
{Load all the Value Names}
for i := 0 to Lista.Count -1 do begin
reg.OpenKey(CLAVE + "\" +Lista.Strings[i],false);
reg.GetValueNames(Lista2);
{We will show only if there is "DisplayName"}
n:=Lista2.IndexOf("DisplayName");
if (n <> -1) and (Lista2.IndexOf("UninstallString")<>-1) then
begin
{DisplayName+UnInstallString}
Memo1.Lines.Append ( reg.ReadString(Lista2.Strings[n])+"-"+
reg.ReadString(Lista2.Strings[Lista2.IndexOf("UninstallString")]) );
end;
end;
{Free temporals}
Lista.Free;
Lista2.Free;
reg.CloseKey;
reg.Destroy;
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
procedure TForm1.Button1Click(Sender: T);
var
PIDL:PItemIDList;
Info:TShellExecuteInfo;
pInfo:PShellExecuteInfo;
WaitCode:DWord;
begin
{get PIDL of the virtual folder}
SHGetSpecialFolderLocation(Handle,
CSIDL_PRINTERS,
PIDL);
{Pointer to Info}
pInfo:=@Info;
{Fill info}
with Info do
begin
cbSize:=SizeOf(Info);
fMask:=SEE_MASK_NOCLOSEPROCESS+
SEE_MASK_IDLIST;
wnd:=Handle;
lpVerb:=nil;
lpFile:=nil;
{Executable parameters}
lpParameters:=nil;
lpDirectory:=nil;
nShow:=SW_ShowNormal;
hInstApp:=0;
lpIDList:=PIDL;
end;
{Execute}
ShellExecuteEx(pInfo);
{Wait to finish}
repeat
WaitCode := WaitForSingle(Info.hProcess,500);
Application.ProcessMessages;
until (WaitCode <> WAIT_TIMEOUT);
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
نحوه اضافه کردن یک ستون برای شماره ردیف در گرید
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1. create new blank field in dbgrid
2. rename the title with "No"
3. put this code in OnDrawColumncell
4. Now your Grid has a row number
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
procedure TForm1.DBGrid1DrawColumnCell(Sender: T; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if DataSource1.DataSet.RecNo > 0 then
begin
if Column.Title.Caption = "No" then
DBGrid1.Canvas.TextOut(Rect.Left + 2, Rect.Top, IntToStr(DataSource1.DataSet.RecNo));
end;
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
نحوه افزدون کابر - تعریف کاربر برای لاگین در بانک اس کیو ال سرور
procedure TForm1.Button1Click(Sender: T);
begin
ADOConnection1.Connected := True;
ADOCommand1.CommandText := "Exec SP_AddLogin " + QuotedStr("UserName") +
"," + QuotedStr("Password") + "," + QuotedStr("Database Name") + "," +
QuotedStr("English") + ";";
ADOCommand1.Execute;
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
برای ریجستر کردن فایل های
ocx از این روش استفاده نماییدprocedure TForm1.Button1Click(Sender: T);
type
TDLLRegisterServer = function: HResult stdcall;
var
MangoOCX : THandle;
Registrar : TDllRegisterServer;
begin
{Cargamos el OCX}
{Load the OCX}
MangoOCX:= LoadLibrary("c:\windows\system\html.ocx");
{Hallamos la direccion de la funcion para registrar el OCX}
{Get the address to register the OCX}
Registrar:= GetProcAddress(MangoOCX, "DllRegisterServer");
{Llamamos a la funci?n}
{Call to the function}
if Registrar <> 0 then ShowMessage("Error");
{Liberamos el OCX}
{Free the OCX}
FreeLibrary(MangoOCX);
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
با استفاده از این تابع شما می توانید دو رشته متنی را با هم مقایسه کنید البته با قابلیت استفاده از علامت های جایگزین * و ؟ جهت مقایسه دو رشته متنی
function MatchStrings(source, pattern: String): Boolean;
var
pSource: array [0..255] of Char;
pPattern: array [0..255] of Char;
function MatchPattern(element, pattern: PChar): Boolean;
function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,"*") <> nil;
if not Result then Result := StrScan(pattern,"?") <> nil;
end;
begin
if 0 = StrComp(pattern,"*") then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
"*": if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
"?": Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin
StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;
uses
ComObj;
function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
v: OLEvariant;
begin
Result := True;
try
v := CreateOLE("JRO.JetEngine");
try
V.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+DB,
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+DB+"x;Jet OLEDB:Engine Type=5"); DeleteFile(DB);
RenameFile(DB+"x",DB);
finally
V := Unassigned;
end;
except
Result := False;
end;
end;
با استفاده از این تابع می توانید یک فایل را به وسیله آدرس دهی مکان جاری و مکانی که می خواهید این فایل را در آن کپی کنید استفاده نمایید
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
S := TFileStream.Create( sourcefilename, fmOpenRead );
try
T := TFileStream.Create( targetfilename,
fmOpenWrite or fmCreate );
try
T.CopyFrom(S, S.Size ) ;
finally
T.Free;
end;
finally
S.Free;
end;
End
کپی کردن تاریخ یک فایل بر اساس تاریخ یک فایل دیگر
procedure CopyFileDate(const Source, Dest: String);
var SourceHand, DestHand: word;
begin SourceHand := FileOpen(Source, fmOutput); { open source file }
DestHand := FileOpen(Dest, fmInput); { open dest file }
FileSetDate(DestHand, FileGetDate(SourceHand)); { get/set date }
FileClose(SourceHand); { close source file }
FileClose(DestHand); { close dest file }
endبرگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
function GetFileSizeOnDisk(const FileName: TFileName): Cardinal;
var
spc,bps,nofc,tnoc : Cardinal;
ClusterSize,
ClustersCount,
FileSize : Cardinal;
begin
Result := 0;
if not FileExists(FileName) then
Exit;
//Call GetDiskFreeSpace to find out disk cluster size.
if not GetDiskFreeSpace(PAnsiChar(ExtractFileDrive(FileNa me)),spc,bps,nofc,tnoc) then
Exit;
//Cluster size = Bytes Per Sector * Sectors Per Cluster
ClusterSize := bps * spc;
//Get actual file size.
FileSize := GetCompressedFileSize(PAnsiChar(FileName),nil);
ClustersCount := FileSize div ClusterSize;
//Calculate file size on the disk.
Result := ClustersCount * ClusterSize;
//if the file occupies a cluster partially, add cluster size to file size, because
//a cluster is the smallest unit of disk which is accesible.
if FileSize > Result then
Inc(Result,ClusterSize);
end;
برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)
یک ساعت فوق العاده
اضافه کردن زبان فارسی به ویندوز XP
یک Message Dialog با امکان تغییر نوشته ی دکمه و تمام قسمتها
بستن پنجره
پاک کردن برنامه به وسیله ی خودش
دانلود کردن سورس یک سایت
بدست آوردن آدرس جاری IE
پاک کردن آدرسهای IE
آموزش کار با IntraWeb در دلفی
مبدل ها
تصویر به bmp2icon) Icon)
تشخیص اینکه HARD DISK ما چند درایو دارد.
اینم یک برنامه ای که ICON درایوها را تغییر می دهد.
درست کردن فیلتر زرد رنگ روی ایمیج
[همه عناوین(126)][عناوین آرشیوشده]
بازدید دیروز: 50
کل بازدید :88608
در این وبلاگ سعی میکنم مطالب مربوط به برنامه نویسی دلفی ، پاسکال و گرافیک رایانه ای 2 بعدی و 3 بعدی را به روز کنم منتظر سوالات شما نیز هستم
قویترین سایت دانلود رایگان نرم افزار [18]
دانلود رایگان نرم افزار [40]
دایره المعارف فارسی رایانه [22]
اخبار فناوری 2 [29]
فروش انواع نوت بوک [32]
کتابخانه مجازی ایران [25]
مقالات آماده کامپیوتری [33]
بزرگترین سایت دانلود3 [74]
اخبار فناوری 1 [18]
خفن ترین کدهای جاوا اسکریپت [29]
قیمت انواع سخت افزار2 [34]
آخرین قیمت سخت افزار ها [23]
دانلود کتاب های فارسی [49]
علم الکترونیک و کامپیوتر [28]
[آرشیو(20)]
