'Last Modified' bilgisini almak

Kullanımı: label1Caption:=FileLastModified('c:\autoexecbat' ) ; ~~~~~~~~~~~~~~~~~~~~~~~~~ function FileLastModified (const TheFile: string): string; var FileH : THandle; LocalFT : TFileTime; DosFT : DWORD; LastAccessedTime : TDateTime; FindData : TWin32FindData; begin Result := ''; FileH := FindFirstFile(PChar(TheFile), FindData) ; if FileH <> INVALID_HANDLE_VALUE then begin WindowsFindClose(Handle) ; if (FindDatadwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = 0 then begin FileTimeToLocalFileTime (FindDataftLastWriteTime,LocalFT) ; FileTimeToDosDateTime (LocalFT,LongRec(DosFT)Hi,LongRec(DosFT)Lo) ; LastAccessedTime := FileDateToDateTime(DosFT) ; Result := DateTimeToStr(LastAccessedTime) ; end; end; end; • Windows Start-Documents bölümüne dosya eklemek

procedure AddtoDocMenu(fName : String) ;
begin
SHAddToRecentDocs(SHARD_PATH, PChar(fName)) ;
end;

• Form üzerine "crosshair" eklemek

procedure TForm1FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
{ I wrote this procedure with in this block for easy access, this one draws the cross hair}
Procedure DrawCross(AX,AY:Integer);
Begin
With Form1Canvas Do
Begin
{ By putting pen mode to Xor will help to erase the previous cross hair }
Form1CanvasPenMode:=pmNotXor;
MoveTo(Ax,0);
LineTo(Ax,Form1Height);
MoveTo(0,AY);
LineTo(Form1Width,AY);
End;
End;
begin
If Not FirstMove Then
DrawCross(OldX,OldY)
Else
FirstMove:=False;
DrawCross(X,Y);
Form1Caption:='X : '+IntToStr(X)+' Y : '+IntToStr(Y);
OldX:=X;
OldY:=Y;
end;
procedure TForm1FormCreate(Sender: TObject);
begin
FirstMove:=True;
end;

• Komut satırından parametre okumak

procedure TForm1FormCreate(Sender: TObject);
Var
I : Integer;
begin
Memo1LinesClear;
Memo1LinesAdd('Parameters Count : '+IntToStr(ParamCount));
{ ParamCount - Returns the number of parameters passed on the command line }
If ParamCount>0 Then
For I:=1 To ParamCount Do
{ ParamStr - Returns a specified parameter from the command-line }
Memo1LinesAdd('Parameter '+IntToStr(I)+' : '+ParamStr(I)) end;

• Disket sürücünün durumu

type
TDriveState = (DSNODISK, DSUNFORMATTEDDISK, DSEMPTYDISK, DSDISK_WITHFILES);

function DriveState (driveletter: Char) : TDriveState;
var
mask: String[6];
sRec: TSearchRec;
oldMode: Cardinal;
retcode: Integer;
begin
oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);
mask:= '?:\**';
mask[1] := driveletter;
{$I-}
retcode := FindFirst (mask, faAnyfile, SRec);
FindClose(SRec);
{$I+}
case retcode of
0: Result := DSDISK_WITHFILES; { at least one file was found }
-18: Result := DSEMPTYDISK; { no files, but disk is ok }
-21, -3: Result := DSNODISK; { DOS ERRORNOTREADY in WinNT,
ERRORPATH_NOTFOUND in 31 }
else
Result := DSUNFORMATTEDDISK; { unformatted disk in drive }
end;
SetErrorMode(oldMode);
end; { DriveState }

• Geri Dönüşüm Kutusuna Dosya Göndermek

procedure RecycleFile(s : string);
var
SHFileOpStruct : TSHFileOpStruct;
begin
with SHFileOpStruct do
begin
Wnd := 0;
wFunc := FO_DELETE; // we want to delete a file
pFrom := PChar(s+#0+#0); // this file
pTo := nil;
fFlags := FOF_ALLOWUNDO; // able to "Undo" (recycle)
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation(SHFileOpStruct); // to the Recycle Bin
end;

• Menuleri programdan açmak

keybd_event(VK_MENU, MapVirtualkey(VK_MENU, 0 ), 0, 0);
keybd_event(Ord('F'), MapVirtualKey(Ord('F'), 0), 0, 0);
keybd_event(Ord('F'), MapVirtualKey(Ord('F'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_MENU, MapVirtualkey(VK_MENU, 0 ), KEYEVENTF_KEYUP, 0);

• Ip adresini bulmak

uses
WinSock; // type PHostEnt

function My_IP_Address : longint;
var
buf : array [0255] of char;
RemoteHost : PHostEnt;
begin
WinsockGetHostName(@buf, 255);
RemoteHost:=WinsockGetHostByName(buf);
if RemoteHost=NIL then
My_IP_Address := winsockhtonl($07000001) { 127001 }
else
My_IP_Address := longint(pointer(RemoteHost^h_addr_list^)^);
Result := Winsockntohl(Result);
end;

• Windows' da yüklü yazıcıların listesi ve port bilgisi

Unit listesine "printers" unitini ekleyin
var Printer:TPrinter;
begin
Printer:=TPrinterCreate;
Memo1LinesAssign(PrinterPrinters);

• Windowsa bir dosyanın açtırılması

Unit listesine "shellapi" unitini ekleyin
shellexecute(0,'open', 'c:\autoexecbat','','',SW_NORMAL);

• Ekran çözünürlüğünü öğrenmek

ShowMessage('Çözünürlük: '+IntToStr( ScreenWidth ) +' x '+ IntToStr( ScreenHeight ));

• Table nesnesinde Locate ile birden fazla alanda aratmak

with musteri do
Locate('isim;soyad;meslek', VarArrayOf(['Mete', 'YILMAZ', 'Programcı']), [loPartialKey]);

• WEB sayfasının açılması işlemi

ShellExecute(Handle, 'open', 'http://wwwprogramlarimcom', nil, nil, sw_ShowMaximized);

• DOS programının çalıştırılması

WinExec('commandcom /c programimexe',sw_ShowNormal);

• Programı bekletmek

(1000milisaniye = 1 saniye)
Sleep(10000);

• Excel ile işlem yapmak

uses
OleAuto; // Delphi 3
ComObj; // Delphi 5

var
vExcel: variant;

procedure TForm1Button1Click(Sender: TObject);
begin
vExcel := CreateOleObject('ExcelApplication');
vExcelWorkbooksAdd;
vExcelActiveWorkbookWorksheets(1)Range('A1')Va lue := 'Hello World';
vExcelVisible := True;
end;

procedure TForm1FormDestroy(Sender: TObject);
begin
if not VarIsEmpty(vExcel) then vExcelQuit;
end;

• Transparent formlar

type
TMyForm = class(TForm)
procedure FormCreate(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
end;

procedure TMyFormCreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
// this is the important constant!
ParamsExStyle:= ParamsExStyle or WS_EX_TRANSPARENT;
end;

Procedure TMyFormFormCreate(Sender: TObject);
begin
inherited;
CanvasBrushStyle := bsClear;
end;

• Clibboard işlemi ( kopyala, yapıştır )

procedure CopyButtonClick(Sender: TObject);
begin
if ActiveControl is TMemo then TMemo(ActiveControl)CopyToClipboard;
if ActiveControl is TDBMemo then TDBMemo(ActiveControl)CopyToClipboard;
if ActiveControl is TEdit then TEdit(ActiveControl)CopyToClipboard;
if ActiveControl is TDBedit then TDBedit(ActiveControl)CopyToClipboard;
end;

procedure PasteButtonClick(Sender: TObject);
begin
if ActiveControl is TMemo then TMemo(ActiveControl)PasteFromClipboard;
if ActiveControl is TDBMemo then TDBMemo(ActiveControl)PasteFromClipboard;
if ActiveControl is TEdit then TEdit(ActiveControl)PasteFromClipboard;
if ActiveControl is TDBedit then TDBedit(ActiveControl)PasteFromClipboard;
end;

• Animated cursor kullanmak

const
crMyCursor = 1;
procedure TForm1FormCreate(Sender: TObject);
begin
ScreenCursors[crMyCursor] := LoadCursorFromFile('c:\mystuff\mycursorani');
Cursor := crMyCursor;
end;

• Formun boyutlarını sınırlandırmak

type
TForm1 = class(TForm)
protected
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
message WM_GETMINMAXINFO;
end;
procedure TForm1WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
begin
with MessageMinMaxInfo^ do
begin
ptMinTrackSize := Point(100, 100);
ptMaxTrackSize := Point(200, 200);
end;
end;

• TMemo'ya border eklemek

var
Rect : TRect;
begin
SendMessage(Memo1Handle, EM_GETRECT, 0, LongInt(@Rect));
RectLeft := 20;
SendMessage(Memo1Handle, EM_SETRECT, 0, LongInt(@Rect));
Memo1Refresh;

• Programı windows açılışına çalıştırmak

Procedure OnStartup (const PgmTitle, CmdLine: String; RunOnce: boolean);
Var
Key : String;
Reg : TRegIniFile;
Begin
If RunOnce Then
Key := 'Once' #0
Else
Key := #0;
Reg := TRegIniFilecreate ('');
RegRootKey := HKEY_LOCAL_MACHINE;
RegWriteString ('Software\Microsoft\Windows\CurrentVersion\Run' + Key,
ProgTitle, CmdLine);
RegFree
End;

• LAN ( network ) bağlantısı kontrolü

const
MAX_NEIGHBORS = 20;
Function NetAvailable : Boolean;
Var
NetRes : Array [0MAX_NEIGHBORS] Of TNetResource;
NNError,
hEnum,
EntryCount,
NetResLen : DWORD;
loop1 : Integer;
Begin
hEnum := -1;
Result := FALSE;
Try
NNError := WNetOpenEnum (RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, Nil, hEnum);
If NNError = NO_ERROR Then
Begin
While NNError <> ERROR_NO_MORE_ITEMS Do
Begin
EntryCount := 1;
NetResLen := SizeOf (NetRes);
NNError := WNetEnumResource (hEnum, EntryCount, @NetRes, NetResLen);
If (NNError = NO_ERROR) Then
Begin
For loop1 := 1 to EntryCount Do
Begin
If Pos ('Microsoft', NetRes[0]lpProvider) = 1 Then
Begin
Result := TRUE;
Break
End
End
End
Else
Begin
Break
End
End;
WNetCloseEnum (hEnum)
// enum kapat
End
Except
On exception Do
If DEBUG Then
Begin
ShowMessage ('Network Neighborhood kontrolü hata verdi')
End;
End
End;