Tips dan Trik Delphi - Files

procedure SaveStringGrid(AStringGrid: TStringGrid; const AFileName: TFileName);
var
  F: TextFile;
  I, K: Integer;
begin
    AssignFile(F, AFileName);
    Rewrite(F);
    with AStringGrid do
    begin
        // Write number of Columns/Rows
        Writeln(F, ColCount);
        Writeln(F, RowCount);
        // loop through cells
        for I := 0 to ColCount - 1 do
          for K := 0 to RowCount - 1 do
            Writeln(F, Cells[I, K]);
    end;
    CloseFile(F);
end;

uses JPEG;

var
  JPEG: TJPEGImage;
  Bitmap: TBitmap;
begin
  JPEG := TJPEGImage.Create;
  Bitmap := TBitmap.Create;
  try
    // Silahkan di rubah sesuai direktori anda masing masing
    Bitmap.LoadFromFile('C:\MyDir\MyFile.bmp');
    JPEG.Assign(Bitmap);
    Image1.Picture.Assign(JPEG);
  finally
    JPEG.Free;
    Bitmap.Free;
  end;
end;

function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
    SA: TSecurityAttributes;
    SI: TStartupInfo;
    PI: TProcessInformation;
    StdOutPipeRead, StdOutPipeWrite: THandle;
    WasOK: Boolean;
    Buffer: array[0..255] of AnsiChar;
    BytesRead: Cardinal;
    WorkDir: string;
    Handle: Boolean;
begin
    Result := '';
    with SA do
    begin
          nLength := SizeOf(SA);
          bInheritHandle := True;
          lpSecurityDescriptor := nil;
    end;
    CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
    try
      with SI do
      begin
        FillChar(SI, SizeOf(SI), 0);
        cb := SizeOf(SI);
        dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        wShowWindow := SW_HIDE;
        hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
        hStdOutput := StdOutPipeWrite;
        hStdError := StdOutPipeWrite;
      end;
      WorkDir := Work;
      Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                              nil, nil, True, 0, nil,
                              PChar(WorkDir), SI, PI);
      CloseHandle(StdOutPipeWrite);
      if Handle then
        try
          repeat
            WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
            if BytesRead > 0 then
            begin
              Buffer[BytesRead] := #0;
              Result := Result + Buffer;
            end;
          until not WasOK or (BytesRead = 0);
          WaitForSingleObject(PI.hProcess, INFINITE);
        finally
          CloseHandle(PI.hThread);
          CloseHandle(PI.hProcess);
        end;
    finally
      CloseHandle(StdOutPipeRead);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Memo1.Text := GetDosOutput(Edit1.Text);
end;

function TForm1.GetFileSize(FName: string): Int64;
var
  ch: File;
  OldMode: Integer;
begin
     OldMode := FileMode;
     Result := -1;
     if not FileExists(FName) then Exit;
     try
        AssignFile(ch, FName);
        FileMode := 0;
        Reset(ch,1);
        Result := FileSize(ch);
     finally
        CloseFile(ch);
        FileMode := OldMode;
     end;
end;

// Atau bisa cara seperti dibawah ini
function TextfileSize(const name: string): LongInt; 
var
  SRec: TSearchRec;
begin
  if FindFirst(name, faAnyfile, SRec) = 0 then
  begin
    Result := SRec.Size;
    Sysutils.FindClose(SRec);
  end
  else
    Result := 0;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
     if OpenDialog1.Execute then
     begin
          Edit1.Text := FormatFloat('###.###,##',(GetFileSize(OpenDialog1.FileName))) +' byte';
     end;
end;

var
  Form1: TForm1;
  Nums: array[1..10] of Word;


implementation

{$R *.dfm}

procedure SortShell(var aSort: array of Word);
var
  iI, iJ, iK,
  iSize: Integer;
  wTemp: Word;
begin
  iSize := High(aSort);
  iK := iSize shr 1;
  while iK > 0 do begin
    for iI := 0 to iSize - iK do begin
      iJ := iI;
      while (iJ >= 0) and (aSort[iJ] > aSort[iJ + iK]) do begin
        wTemp := aSort[iJ];
        aSort[iJ] := aSort[iJ + iK];
        aSort[iJ + iK] := wTemp;
        if iJ > iK then
          Dec(iJ, iK)
        else
          iJ := 0
      end;
    end;
    iK := iK shr 1;
  end;
end;

procedure AddToLB(const Nums: array of Word; LB: TListBox);
var
  I: Integer;
begin
     for I := Low(Nums) to High(Nums) do
     begin
          LB.Items.Add(IntToStr(Nums[I]));
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
     // memasukkan secara acak
     Randomize;
     for I := Low(Nums) to High(Nums) do
     begin
          Nums[I] := Random(50);
     end;

     AddToLB(Nums, ListBox1);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     // Urutkan Angka
     SortShell(Nums);
     AddToLB(Nums, ListBox2);
end;

uses
  WinTypes, ShellAPI;

procedure OpenObject(sObjectPath: string);
begin
     ShellExecute(0, nil, PChar(sObjectPath ), nil, nil, SW_NORMAL);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     OpenObject('C:\sidesamaju\instalasi.txt');
end;

// Konek dengan server ftp
idFTP1.Host := Edit_Host.Text;
idFTP1.Username := Edit_Name.Text;
idFTP1.Password := Edit_password.Text;
try
   idFTP1.Connect;
finally
	if idFTP1.Connected = True Then
	    Shape_Conect.Brush.Color := clLime;
end;

// Upload file image ke ftp
var
    m : TStream;
    f : TStream;
    t : Cardinal;
    Nama_folder,
    Auxiliar :String;
    Diretory : String;
    contador : Integer;
begin
    Auxiliar := '';
    f := nil;
    m := nil;

    Memo_keterangan.Lines.Add('Original Directory:' + Diretory);
    OpenDialog1.Filter := 'Files(*.*)|*.*';

    if OpenDialog1.Execute then
    begin
            Nama_folder := OpenDialog1.FileName;

            Memo_keterangan.Lines.Add ('Operation: local directory change');
            Memo_keterangan.Lines.Add ('File directory: ' + GetCurrentDir);
            Memo_keterangan.Lines.Add ('');

            Nama_folder := AnsiStrRScan(PCHar(Nama_folder), '\');
            for contador := 2 To StrLen(PCHar(Nama_folder)) do
            Auxiliar := Auxiliar + Nama_folder [contador];
            Nama_folder := Auxiliar;

            try
                  Memo_keterangan.Lines.Add('Operation: Upload');
                  Memo_keterangan.Lines.Add ('Local file: ' + OpenDialog1.FileName);
                  Memo_keterangan.Lines.Add ('Recorded as: ' + Nama_folder);

                  f := TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
                  m := TMemoryStream.Create;
                  m.CopyFrom(f,f.Size);
                  m.Seek(0,0) ;
                  t := GetTickCount;
                  idFTP1.Put(m,Nama_folder);

                  Memo_keterangan.Lines.Add(Format('Time %d miliseconds',[GetTickCount - t]));
                  Memo_keterangan.Lines.Add(Format('Size %d bytes',[m.Size]));
                  Memo_keterangan.Lines.Add('');

            finally
                  m.Free;
                  f.Free;
            end;
    end;

    SetCurrentDir(Diretory);
    Memo_keterangan.Lines.Add('Operation: change of local directory');
    Memo_keterangan.Lines.Add ('Ddirectory after the operation:' + GetCurrentDir);
    Memo_keterangan.Lines.Add ('');
end;


// Disknek dengan server ftp
try
	idFTP1.Disconnect;
finally
	if idFTP1.Connected = False then
		Shape_Conectado.Brush.Color := clGray;
end;

// Konek dengan server ftp
idFTP1.Host := Edit_Host.Text;
idFTP1.Username := Edit_Name.Text;
idFTP1.Password := Edit_password.Text;
try
   idFTP1.Connect;
finally
	if idFTP1.Connected = True Then
	    Shape_Conect.Brush.Color := clLime;
end;

// Upload file image ke ftp
var
     Stream: TStream;
begin
   try
       Stream:= TMemoryStream.Create;
       if IdFTP1.Connected then
       begin
         if image1.Picture<>nil then
         begin
           Image1.Picture.Graphic.SaveToStream(Stream);
           Stream.Position := 0;
           IdFTP1.Put(Stream,StringReplace(DateTimeToStr(now)+'coba.jpg','/','',[rfReplaceAll]),true);
        end;
      end;
    finally
      stream.Free;
    end;
end;


// Disknek dengan server ftp
try
	idFTP1.Disconnect;
finally
	if idFTP1.Connected = False then
		Shape_Conectado.Brush.Color := clGray;
end;

Konek dengan server ftp

idFTP1.Host := Edit_Host.Text;
idFTP1.Username := Edit_Name.Text;
idFTP1.Password := Edit_password.Text;
try
   idFTP1.Connect;
finally
	if idFTP1.Connected = True Then
	    Shape_Conect.Brush.Color := clLime;
end;

Membaca file dari JPG ftp 
var
  MS : TMemoryStream;
  Jpg: TJPEGImage;
begin
      MS := TMemoryStream.Create;
      Jpg := TJPEGImage.Create;
      try
        IdHTTP1.get('http://kursusdelphi.com/images/teacher1.jpg',MS);
        Ms.Seek(0,soFromBeginning);
        Jpg.LoadFromStream(MS);
        Image1.Picture.Assign(Jpg);

      finally
        FreeAndNil(Jpg);
        FreeAndNil(MS);
      end;
end;

Membaca file dari png ftp 

var
  MS : TMemoryStream;
  png: TPngImage;
begin
  MS := TMemoryStream.Create;
  png := TPngImage.Create;
  try
    IdHTTP1.get('http://kursusdelphi.com/images/logo.png',MS);
    Ms.Seek(0,soFromBeginning);
    png.LoadFromStream(MS);
    Image1.Picture.Assign(png);

  finally
    FreeAndNil(png);
    FreeAndNil(MS);
  end;
end;


Disknek dengan server ftp
try
	 idFTP1.Disconnect;
finally
	if idFTP1.Connected = False then
		 Shape_Conectado.Brush.Color := clGray;
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;