Tips dan Trik Delphi - Files

 uses inifiles;
procedure fnLog(FMessage : String);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create(fnGetLoc + 'log.ini');
  try
    ini.WriteString('Log', FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ' ', ' ' + FMessage);
  finally
    ini.DisposeOf;
  end;
end;

procedure fnLog(FKey, FMessage : String);
var
  ini: TIniFile;
begin
  ini := TIniFile.Create(fnGetLoc + 'log.ini');
  try
    ini.WriteString('Log', FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ' ', ' [' + FKey + '] - ' + FMessage);
  finally
    ini.DisposeOf;
  end;
end;

  private
    { Private declarations }
    hLib2: THandle;
    DllStr1: string;
    FKeyCount: Integer;
    procedure DllMessage(var Msg: TMessage); message WM_USER + 1678;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DllMessage(var Msg: TMessage);
begin
  Inc(FKeyCount);
  Label2.Caption := Format('KeyCount: %d',[FKeyCount]);
  if (Msg.wParam = 8) Then
  Begin
       Memo1.Clear;
       Exit;
  End;
  if (Msg.wParam = 13) then
  Begin

       Exit;
  End;

  DllStr1 := DllStr1 + Chr(Msg.wParam);
  label1.Caption := DllStr1;
end;


procedure TForm1.Button1Click(Sender: TObject);
type
  TStartHook = function(MemoHandle, AppHandle: HWND): Byte;
var
  StartHook1: TStartHook;
  SHresult: Byte;
begin
    hLib2 := LoadLibrary('HookLib.dll');
    @StartHook1 := GetProcAddress(hLib2, 'StartHook');
    if @StartHook1 = nil then
      Exit;
    SHresult := StartHook1(Memo1.Handle, Handle);
    if SHresult = 0 then ShowMessage('the Key Hook was Started, good');
    if SHresult = 1 then ShowMessage('the Key Hook was already Started');
    if SHresult = 2 then ShowMessage('the Key Hook can NOT be Started, bad');
    if SHresult = 4 then ShowMessage('MemoHandle is incorrect');
    FKeyCount := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
type
  TStopHook = function: Boolean;
var
  StopHook1: TStopHook;
  hLib21: THandle;
begin
      @StopHook1 := GetProcAddress(hLib2, 'StopHook');
      if @StopHook1 = nil then
      begin
        ShowMessage('Stop Hook DLL Mem Addy not found');
        Exit;
      end;
      if StopHook1 then
        ShowMessage('Hook was stoped');
      FreeLibrary(hLib2);
      {for some reason in Win XP you need to call FreeLibrary twice
      maybe because you get 2 functions from the DLL? ?}
      FreeLibrary(hLib2);
end; 

Gunakan ilmu ini untuk kebutuhan baik


                                        

uses ShellAPI;

function FileDeleteRB(FileName:string): boolean;
var
    fos : TSHFileOpStruct;
begin
    FillChar(fos, SizeOf(fos), 0);
    with fos do
    begin
        wFunc :=FO_DELETE;
        pFrom := PChar(FileName);
        fFlags := FOF_ALLOWUNDO
        or FOF_NOCONFIRMATION
        or FOF_SILENT;
    end;
    Result := (ShFileOperation(fos)=0);
end;

procedure FindAll(const Path: String; Attr: Integer; List: TStrings);
var
    Res: TSearchRec;
    EOFound: Boolean;
begin
    EOFound:= False;
    if FindFirst(Path, Attr, Res) < 0 then
    exit else
    while not EOFound do
    begin
        List.Add(Res.Name);
        EOFound:= FindNext(Res) <> 0;
    end;
    FindClose(Res);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     FindAll('C:\Windows\*.*', faAnyFile, ListBox1.Items);
end;

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
          Windows.FindClose(Application.Handle);
          if (FindData.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = 0 then
          begin
              FileTimeToLocalFileTime
              (FindData.ftLastWriteTime,LocalFT);
              FileTimeToDosDateTime
              (LocalFT,LongRec(DosFT).Hi,LongRec(DosFT).Lo);
              LastAccessedTime :=FileDateToDateTime(DosFT);
              Result := DateTimeToStr(LastAccessedTime);
          end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    label1.Caption := FileLastModified('c:\autoexec.bat');
end;

uses ShellAPI;

Function DelTree(DirName : string):Boolean;
var
    SHFileOpStruct : TSHFileOpStruct;
    DirBuf : array[0..255]of char;
begin
    try
        Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0);
        FillChar(DirBuf, Sizeof(DirBuf), 0 );
        StrPCopy(DirBuf, DirName);
        with SHFileOpStruct do
        begin
            Wnd := 0;
            pFrom :=@DirBuf;
            wFunc :=FO_DELETE;
            fFlags := FOF_ALLOWUNDO;
            fFlags := fFlags or FOF_NOCONFIRMATION;
            fFlags := fFlags or FOF_SILENT;
        end;
        Result := (SHFileOperation(SHFileOpStruct) = 0);
    except
        Result := False;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    DelTree('C:\Temp');
end;

procedure SaveStringToFile(const aFilename: TFilename; const aString: string);
var
  SL: TStringList;
begin
  SL := TStringList.Create; // call outside the try 
  try
    SL.Text := aString;
    SL.SaveToFile(aFilename);
  finally
    SL.Free // will be called no matter what happens above
  end;
end;

procedure ListFileDir(Path: string; FileList: TStrings);
var
  SR: TSearchRec;
begin
  if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr <> faDirectory) then
      begin
        FileList.Add(SR.Name);
      end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
     ListFileDir('C:\WINDOWS\', ListBox1.Items);
end;

function DirectoryIsEmpty(Directory: string): Boolean;
var
  SR: TSearchRec;
  i: Integer;
begin
  Result := False;
  FindFirst(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR);
  for i := 1 to 2 do
    if (SR.Name = '.') or (SR.Name = '..') then
      Result := FindNext(SR) <> 0;
  FindClose(SR);
end;


// Contoh penerapannya:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if DirectoryIsEmpty('C:\test') then
    Label1.Caption := 'empty'
  else
    Label1.Caption := 'not empty';
end;

procedure LoadStringGrid(AStringGrid: TStringGrid; const AFileName: TFileName);
var
  F: TextFile;
  Tmp, I, K: Integer;
  StrTemp: String;
begin
    AssignFile(F, AFileName);
    Reset(F);
    with AStringGrid do
    begin
      // Get number of columns
      Readln(F, Tmp);
      ColCount := Tmp;
      // Get number of rows
      Readln(F, Tmp);
      RowCount := Tmp;
      // loop through cells & fill in values
      for I := 0 to ColCount - 1 do
        for K := 0 to RowCount - 1 do
        begin
          Readln(F, StrTemp);
          Cells[I, K] := StrTemp;
        end;
    end;
    CloseFile(F);
end;