Arsip: Unzip file secara program Delphi

 
user image
more 13 years ago

wati

hello suhu2 delphi disini.tlg dunk gimana cara pake prgram delphi untuk meng unzip file2 yg telah di zip dgn winzip secara otomatis.setiap hari gw perlu mengunzip berberapa file jadi bosan kl manual. kl bisa dengan program delphi kan lebih bagus. tlg ya suhu2 disini kasih tip2 nya.thanks.GBU All.
user image
more 13 years ago

p2bf

Pertanyaan dulu ya...
user image
more 13 years ago

cyber_hecker

hari ini diriku emang iseng banget. :D, boss lagi ke daerah, gak ngerti mau ngerjain apa. jadi ke isengan kita lanjutkan untuk membuat program unzip sederhana. kebutuhan minimum (karena diriku mbikin dengan spec seperti ini) : Winzip Pro 11.1 Winzip Command Line Add-On - http://download.winzip.com/wzcline20.exe Delphi 7 listing program :
unit uWinzip;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;
procedure myMoveFile(const fromDir, toDir: string; const oMemo: TMemo);
function ExecAndWait(FileName:String; Visibility:integer):integer;
type
  TFWinzip = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edExePath: TEdit;
    edZipPath: TEdit;
    edUnzPath: TEdit;
    memUnziped: TMemo;
    memProses: TMemo;
    BitBtn1: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FWinzip: TFWinzip;
  vExePath, vZipPath, vUnzPath, vExtTo : string;
implementation
uses
  ShellApi;
{$R .dfm}
procedure FindFiles(FilesList: TStringList; StartDir, FileMask: string);
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  if StartDir[length(StartDir)] <> '' then
    StartDir := StartDir + '';
  { Build a list of the files in directory StartDir
     (not the directories!)                         }
  IsFound :=
    FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
  while IsFound do begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);
  // Build a list of subdirectories
  DirList := TStringList.Create;
  IsFound := FindFirst(StartDir+' .', faAnyFile, SR) = 0;
  while IsFound do begin
    if ((SR.Attr and faDirectory) <> 0) and
         (SR.Name[1] <> '.') then
      DirList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);
  // Scan the list of subdirectories
  for i := 0 to DirList.Count - 1 do
    FindFiles(FilesList, DirList[i], FileMask);
  DirList.Free;
end;
procedure myMoveFile(const fromDir, toDir: string; const oMemo: TMemo);
var
  lsFile : TStringList;
  sFileName: string;
  i : integer;
begin
  lsFile := TStringList.Create;
  try
    FindFiles(lsFile, fromDir, ' .zip');
    for i := 0 to lsFile.Count - 1 do begin
      sFileName := ExtractFileName(lsFile[i]);
      oMemo.Lines.Append('Move '+ lsFile[i] + ' To ' + toDir);
      MoveFile(PChar(lsFile[i]),PChar(toDir+''+sFileName));
    end;
  finally
    lsFile.Free;
  end;
end;
procedure myExtractFile(const fromDir, toDir: string; const oMemo: TMemo);
var
  lsFile : TStringList;
  sFileName: string;
  i : integer;
begin
  lsFile := TStringList.Create;
  try
    FindFiles(lsFile, fromDir, '.zip');
    for i := 0 to lsFile.Count - 1 do begin
      sFileName := ExtractFileName(lsFile[i]);
      oMemo.Lines.Append('Extract '+ sFileName + ' To ' + toDir);
      ExecAndWait(vExePath+'\WZUNZIP.EXE -ye -o '+lsFile[i]+' "'+
        vExtTo+'"', SW_SHOW);
    end;
  finally
    lsFile.Free;
  end;
end;
procedure TFWinzip.FormCreate(Sender: TObject);
var
  lsList: TStringList;
begin
  lsList := TStringList.Create;
  try
    with lsList do begin
      LoadFromFile(ExtractFilePath(ParamStr(0))+'setting.ini');
      vExePath := Values['ExePath'];
      vZipPath := Values['ZipPath'];
      vUnzPath := Values['UnzPath'];
      vExtTo   := Values['ExtTo'];
      edExePath.Text := vExePath;
      edZipPath.Text := vZipPath;
      edUnzPath.Text := vUnzPath;
      lsList.Clear;
      FindFiles(lsList, vUnzPath, ' .zip');
      memUnziped.Lines := lsList;
    end;
  finally
    lsList.Free;
  end;
end;
function ExecAndWait(FileName:String; Visibility:integer):integer;
var
  zAppName:array of char;
  zCurDir:array of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
  Resultado: DWord;
begin
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                      { pointer to command line string }
    nil,                           { pointer to process security attributes}
    nil,                           { pointer to thread security attributes}
    false,                         { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    nil,                           { pointer to current directory name }
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }
  else begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess,Resultado);
    Result := Resultado;
  end;
end;
procedure TFWinzip.BitBtn1Click(Sender: TObject);
begin
  myExtractFile(edUnzPath.Text, vExtTo, memProses);
  myMoveFile(edUnzPath.Text, edZipPath.Text, memProses);
end;
end.
setting.ini
ExePath=C:\Program Files\WinZip
ZipPath=D:\RESULT\DELPHI-ID\Winzip\zipped
UnzPath=D:\RESULT\DELPHI-ID\Winzip\unziped
ExtTo=C:\Program Files
logika program ini adalah : akan meng-unzip semua file yang bertipe *.zip pada folder yang telah ditentukan ('...\UnZiped') ke folder khusus untuk file-file unzip ('C:\Program Files'). setelah semua file berhasil di unzip, maka pindahkan file tersebut ke folder khusus sudah di zip ('...\Zipped')
user image
more 13 years ago

n3o_cybertech

Wooow...Cyber_Hecker kereen 'n gak pelit!!! ayo, aq pengagummu......!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ajarin aq donk about DELPHI!!!. ======================================= KEEP SPIRIT OF PROGRAMMING...!!!! =======================================
user image
more 13 years ago

wati

@cyber_hecker: [color=darkblue]hari ini diriku emang iseng banget. :D, boss lagi ke daerah, gak ngerti mau ngerjain apa. jadi ke isengan kita lanjutkan untuk membuat program unzip sederhana. ......
thanks suhu cyber_hecker.aku coba dulu ya....GBU note: quote edited, karena terlalu panjang. bisa rada ringan servernya.
more ...
  • Pages:
  • 1
Share to

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com