[Delphi] Wypakowywanie w pętli

0

Witam, mam pewien problem przerobiłem sobie procedury z unrarexample, ale jak daję w pętli for to tak jakby jej nie wykonywało. Zamieszczam kody:

unrar.dcu

unit unrar;

{$ALIGN OFF}

interface

uses Windows;

const
  ERAR_END_ARCHIVE    = 10;
  ERAR_NO_MEMORY      = 11;
  ERAR_BAD_DATA       = 12;
  ERAR_BAD_ARCHIVE    = 13;
  ERAR_UNKNOWN_FORMAT = 14;
  ERAR_EOPEN          = 15;
  ERAR_ECREATE        = 16;
  ERAR_ECLOSE         = 17;
  ERAR_EREAD          = 18;
  ERAR_EWRITE         = 19;
  ERAR_SMALL_BUF      = 20;

  RAR_OM_LIST         =  0;
  RAR_OM_EXTRACT      =  1;

  RAR_SKIP            =  0;
  RAR_TEST            =  1;
  RAR_EXTRACT         =  2;

  RAR_VOL_ASK         =  0;
  RAR_VOL_NOTIFY      =  1;

  RAR_DLL_VERSION     =  2;

  UCM_CHANGEVOLUME    =  0;
  UCM_PROCESSDATA     =  1;

type
  TRARHeaderData = record
    ArcName,
    FileName: array[0..Pred(260)] of Char;
    Flags,
    PackSize,
    UnpSize,
    HostOS,
    FileCRC,
    FileTime,
    UnpVer,
    Method,
    FileAttr: UINT;
    CmtBuf: PChar;
    CmtBufSize,
    CmtSize,
    CmtState: UINT;
  end;

  TRAROpenArchiveData = record
    ArcName: PChar;
    OpenMode,
    OpenResult: UINT;
    CmtBuf: PChar;
    CmtBufSize,
    CmtSize,
    CmtState: UINT;
  end;

  TUnrarCallback = function (Msg: UINT; UserData, P1, P2: Integer) :Integer; stdcall;
  TRAROpenArchive = function (var ArchiveData: TRAROpenArchiveData): THandle;  stdcall;
  TRARCloseArchive = function (hArcData: THandle): Integer; stdcall;
  TRARReadHeader = function (hArcData: THandle; var HeaderData: TRARHeaderData): Integer; stdcall;
  TRARProcessFile = function (hArcData: THandle; Operation: Integer; DestPath, DestName: PChar): Integer;  stdcall;
  TRARSetCallback = procedure (hArcData: THandle; UnrarCallback: TUnrarCallback; UserData:Integer); stdcall;
  TRARSetPassword = procedure (hArcData: THandle; Password: PChar); stdcall;
  TRARGetDllVersion = function: integer; stdcall;

// Wrapper for DLL's function - old unrar.dll doesn't export RARGetDllVersion
// Returns: -1 = DLL not found; 0 = old ver. (C-style callbacks); >0 = new ver.
function RARDllGetVersion: integer;

// Dynamic loading of DLL
function UnrarDllLoad(dllfilename : string) : Boolean;

procedure UnrarDllUnload;


var
  UnrarDllHandle        : THandle;
  RAROpenArchive        : TRAROpenArchive;
  RARCloseArchive       : TRARCloseArchive;
  RARReadHeader         : TRARReadHeader;
  RARProcessFile        : TRARProcessFile;
  RARSetPassword        : TRARSetPassword;
  RARSetCallback        : TRARSetCallback;


implementation

var
  RARGetDllVersion      : TRARGetDllVersion;

function RARDllGetVersion: integer;
begin
  if @RARGetDllVersion=nil then
    Result:= 0
  else
    Result:= RARGetDllVersion;
end;


// Return: True = success
function UnrarDllLoad(dllfilename : string) : Boolean;
var
  r : Boolean;
begin
  r:=False;
  try
    UnrarDllHandle := LoadLibrary(PChar(dllfilename));
    if UnrarDllHandle <> 0 then
    begin
      @RAROpenArchive     := GetProcAddress(UnrarDllHandle, 'RAROpenArchive');
      @RARCloseArchive    := GetProcAddress(UnrarDllHandle, 'RARCloseArchive');
      @RARReadHeader      := GetProcAddress(UnrarDllHandle, 'RARReadHeader');
      @RARProcessFile     := GetProcAddress(UnrarDllHandle, 'RARProcessFile');
      @RARSetPassword     := GetProcAddress(UnrarDllHandle, 'RARSetPassword');
      @RARSetCallback     := GetProcAddress(UnrarDllHandle, 'RARSetCallback');
      @RARGetDllVersion   := GetProcAddress(UnrarDllHandle, 'RARGetDllVersion');
      if (@RAROpenArchive = nil) or (@RARCloseArchive = nil) or
         (@RARReadHeader = nil) or (@RARProcessFile = nil) or
         (@RARSetPassword = nil) or (@RARSetCallback = nil) then
        FreeLibrary(UnrarDllHandle)
      else
        r:=True;
    end;
  except
  end;
  Result:=r;
end;

procedure UnrarDllUnload;
begin
  if UnrarDllHandle <> 0 then
    FreeLibrary(UnrarDllHandle);
end;

end.

Projekt:

...

uses Unrar

...

type
  CharMAX_PATH = array [0..MAX_PATH] of char;
  procedure Wypakuj(pliksciezka:String; docsiezka:String);

...

var
  frmUnrar: TForm1;
  RAROpenArchiveData: TRAROpenArchiveData;
  RARHeaderData: TRARHeaderData;
  RARExtract: boolean;
  RARComment: CharMAX_PATH;
  RARPwd: array [0..80] of char;
  RARFileName: CharMAX_PATH;
  RARStartTime: TDateTime;
  RARElapsedTime: TDateTime;
  iRARDoneTime: integer;
  iRAREsti: integer;
  RARPctDone: integer;
  RarDllLoaded: boolean;
  RARPctLeft: integer;
  Hour, Min, Sec, MSec: word;
  lKBytesDone: longint;
  lTotalSize: longint;
  PctRemain: longint;
  lKBWritten: longint;
  ArchivePwd: string;
  InstallCancel: Boolean;

...

////////////////////////////////////////////////////////////////////////

function RarCallbackProc(msg: UINT; UserData, P1, P2: integer): integer; stdcall;
var
  s: string;
begin
  Result := 0;
  case msg of
    UCM_CHANGEVOLUME:
      if (P2 = RAR_VOL_ASK) then
      begin
      end;
    UCM_PROCESSDATA:
    begin
      if RARExtract then
      begin
        lKBytesDone := lKBytesDone + P2;

        frmUnrar.Refresh;
        Application.ProcessMessages;

        lKBWritten := lKBWritten + (P2 div 1024);
        frmUnrar.ProgressBar1.Position := lKBWritten;
        frmUnrar.Label1.Caption :='Wypakowywuję: '+IntToStr(lKBWritten) +
          ' z ' + IntToStr(lTotalSize) + ' KB';

        if lTotalSize > 0 then
        begin
          RARPctDone := (lKBWritten * 100) div lTotalSize;
          if RARPctDone = 0 then RARPctDone := 1;
        end
        else
          RARPctDone := 50;

        frmUnrar.Refresh;
        Application.ProcessMessages;
        Result := 1;
      end
      else
        Result := 1;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////


function a2o(const s: string): string;
begin
  SetLength(Result, Length(s));
  AnsiToOemBuff(PChar(S), PChar(Result), Length(s));
end;

////////////////////////////////////////////////////////////////////////

procedure TForm1.Wypakuj(pliksciezka:String; docsiezka:String);
var
  s: string;
  j: longint;
  RARrc: integer;
  RARhnd: THandle;
  A: CharMAX_PATH;

  sDir: string;
  PDestPath: CharMAX_PATH;
  Mode: integer;
begin


    if FileExists(pliksciezka) then
    begin
//      Button1.Enabled:=True;

      RAROpenArchiveData.OpenResult := 99;
      StrPCopy(@RARFileName, pliksciezka);
      RAROpenArchiveData.ArcName := @RARFileName;
      RAROpenArchiveData.OpenMode := RAR_OM_LIST;
      RAROpenArchiveData.CmtBuf := @RARComment;
      RAROpenArchiveData.CmtBufSize := 255;

      RARhnd := RAROpenArchive(RAROpenArchiveData);
      if RAROpenArchiveData.OpenResult <> 0 then
      begin
        case RAROpenArchiveData.OpenResult of
          ERAR_NO_MEMORY: s := 'Not enough memory to initialize data structures';
          ERAR_BAD_DATA: s := 'Archive header broken';
          ERAR_BAD_ARCHIVE: s := 'File is not valid RAR archive';
          ERAR_EOPEN: s := 'File open error';
        end;
        MessageDlg('Unable to open rar archive: ' + s + '!', mtError, [mbOK], 0);
        Exit;
      end
      else
      begin
        if ArchivePwd <> '' then // set pwd if specified
          RARSetPassword(RARhnd, @RARPwd);
        RARHeaderData.UnpSize := 0;
        s := 'c:\';
        StrPCopy(@A, s);
        repeat
          RARrc := RARReadHeader(RARhnd, RARHeaderData);
          if RARrc = 0 then
          begin
            RARrc := RARProcessFile(RARhnd, RAR_SKIP, @A, @A);
            j := RARHeaderData.UnpSize div 1024;
            lTotalSize := lTotalSize + j;
          end
          else if (RARrc <> 0) and (RARrc <> ERAR_END_ARCHIVE) then
          begin
            MessageDlg('Header file broken!', mtError, [mbOK], 0);
            Exit;
          end;
        until RARrc <> 0;


        if RARCloseArchive(RARhnd) <> 0 then
        begin
          MessageDlg('Unable to close rar archive!', mtError, [mbOK], 0);
          Exit;
        end;
      end;

    end;
      InstallCancel:=False;

  RARExtract := True;
  Mode := RAR_OM_EXTRACT;
  lKBWritten := 0;
  frmUnrar.ProgressBar1.Position := 0;
  frmUnrar.ProgressBar1.Max := lTotalSize;
  RARStartTime := Time;


  RAROpenArchiveData.OpenResult := 99;
  RAROpenArchiveData.OpenMode := Mode;
  RAROpenArchiveData.ArcName := @RARFileName;
  RAROpenArchiveData.CmtBuf := @RARComment;
  RAROpenArchiveData.CmtBufSize := 255;


  RARhnd := RAROpenArchive(RAROpenArchiveData);
  if RAROpenArchiveData.OpenResult <> 0 then
  begin
    case RAROpenArchiveData.OpenResult of
      ERAR_NO_MEMORY: s := 'Not enough memory to initialize data structures';
      ERAR_BAD_DATA: s := 'Archive header broken';
      ERAR_BAD_ARCHIVE: s := 'File is not valid RAR archive';
      ERAR_EOPEN: s := 'File open error';
    end;
    MessageDlg('Unable to open rar archive: ' + s + '!', mtError, [mbOK], 0);
    Exit;
  end;

  if ArchivePwd <> '' then // set pwd if specified
    RARSetPassword(RARhnd, @RARPwd);

  RARSetCallback(RARhnd, RarCallbackProc, integer(@Mode));

  StrPCopy(@PDestPath, a2o(docsiezka));
  sDir := docsiezka;
  if sDir[Length(sDir)] <> '\' then
    sDir := sDir + '\';

  repeat
    RARrc := RARReadHeader(RARhnd, RARHeaderData);

    if RARrc <> ERAR_END_ARCHIVE then
    begin
      s := StrPas(RARHeaderData.FileName);
      lKBytesDone := 0;
      frmUnrar.Refresh;
      Application.ProcessMessages;
    end;

    if RARrc = 0 then
      RARrc := RARProcessFile(RARhnd, RAR_EXTRACT, @PDestPath, nil);
    if (RARrc <> 0) and (RARrc <> ERAR_END_ARCHIVE) then
    begin
      if (RARrc = 12) or (RARrc = 16) then
      begin
        if FileExists(sDir + s) then
        begin
          if (FileGetAttr(sDir + s)) and (faReadOnly) = 1 then
          begin
              MessageDlg('Unable to overwrite ' + sDir + s + '!', mtError, [mbOK], 0);
          end;
          RARrc := RARProcessFile(RARhnd, RAR_EXTRACT, @PDestPath, nil);
        end;
      end;
      if (RARrc = 12) then
      begin
        MessageDlg('An Error occured during extracting of ' + s + '!' + #13#10 +
          'RARProcessFile: ' + IntToStr(RARrc), mtError, [mbOK], 0);
        Exit;
      end
      else
        RARrc := 0;
    end;
    Application.ProcessMessages;
  until (RARrc <> 0) or (InstallCancel);

  if InstallCancel then
    MessageDlg('Unpacking aborted by user!', mtInformation, [mbOK], 0);

  if RARCloseArchive(RARhnd) <> 0 then
  begin
    MessageDlg('Unable to close rar archive!', mtError, [mbOK], 0);
  end;


end;

////////////////////////////////////////////////////////////////////////

...

procedure TForm1.Button1Click(Sender: TObject);
begin
 for ii:=0 to ListBox1.Count-1 do
begin
 wypakuj(ExtractFilePath(Application.ExeName)+StringReplace(ListBox2.Items.Strings[0], '/', '\', [rfReplaceAll])+'.rar', 'D:\');
 lTotalSize:=0;
 Progressbar2.Position:=ProgressBar2.Position+1;
 try
  DeleteFile(ExtractFilePath(Application.ExeName)+ListBox2.Items.Strings[0]+'.rar');
 except
  Memo1.Lines.Add('Błąd!')
 end;
 ListBox2.Items.Delete(0);
end;
 Label1.Caption:='Koniec!';
end;

Z góry dziękuję za pomoc!

0

Z tym ominięciem już sobie poradziłam, złe nazwy LiztBoxa dałem, ale niestety kolejny problem, wyskakuje mi okienko z błędem:
Project Project1.exe raised exception class EAccessViolation with message 'Access violation at addres 0043AD8C in module 'Project1.exe'. Read of addres 00000000'. Process stopped. Use Step or Run to continue.
Proszę o pomoc.
Pozdrawiam

0

któryś z obiektów lub wskaźników, do których się odwołujesz, nie został zainicjowany.

0

A jak to mogę sprawdzić? Zbytnio nie rozumiem czemu nie działa, skoro w 2aplikacji działa bardzo dobrze ;/

0

użyj debugera, postaw breakpointy, wykonaj kod krok po kroku, zobaczysz w której linijce program się wykłada, i to będzie ta, w której odwołujesz się do niezainicjowanej zmiennej.

[Delphi] Wypakowywanie w pętli

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami