dfunrar.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

  begin
    OpenResult := 0; // Init with RAR_SUCCESS

    // Testing is the same like listing
    if (FMode = DFRAR_LIST) then
      OpenMode   := RAR_OM_LIST
    else
      OpenMode   := RAR_OM_EXTRACT;

    ArcName := PChar(FileName);
    GetMem(Comment, MAXRARCOMMENTSIZE); // Max
    CmtBuf     := Comment;
    CmtBufSize := MAXRARCOMMENTSIZE;
    CmtSize    := FCommentSize;
    CmtState   := CommentResult;
  end;
end;

procedure TDFUnRar.OpenRARArchive;
begin
  DoStatus('', RAR_ONBEFOREOPEN);
  ArchiveHandle := RAROpenArchive(@openArchiveStruc);
  DoStatus('', RAR_ONOPEN);

  case openArchiveStruc.CmtState of
    ERAR_COMMENTS_EXISTS: begin
                            FArchivComment := StrPas(Comment);
                            FCommentSize   := Length(FArchivComment);
                            if assigned(FOnComment) then
                              FOnComment(self, Comment);
                          end; // not from UnRar-Dll !
    ERAR_NO_COMMENTS    : begin
                            FArchivComment := '';
                            FCommentSize := 0;
                          end;   // not from UnRar-Dll !
    ERAR_NO_MEMORY      : DoError(MSG14, ERAR_NO_MEMORY);
    ERAR_BAD_DATA       : DoError(MSG5, ERAR_BAD_DATA);
    ERAR_UNKNOWN_FORMAT : DoError(MSG7, ERAR_UNKNOWN_FORMAT);
    ERAR_SMALL_BUF      : DoError(MSG16, ERAR_SMALL_BUF);
  end;
end;

procedure TDFUnRar.SetRARPassword;
begin
  if FPassword <> '' then
    RARSetPassword(ArchiveHandle, PChar(FPassword));
end;

procedure TDFUnRar.SetMode(value: TDFRarMode);
begin
  FMode := value;

  if Mode = DFRAR_LIST then
    RAROpenMode := RAR_TEST
  else
    RAROpenMode := RAR_EXTRACT;
end;

procedure TDFUnRar.ProcessFileHeader(ReadFileHeaderResult: integer);
begin
  if ReadFileHeaderResult = ERAR_BAD_DATA then
    DoError(MSG17, ERAR_BAD_DATA)
  else
  begin
    if assigned(FOnFileProcessing) or assigned(FOnProgress) then
    begin
      ConvertHeader;

      if assigned(FOnFileProcessing) then
        FOnFileProcessing(self, hdrDFData, ReadFileHeaderResult);
      if assigned(FOnProgress) then
      begin
        Inc(FFilesProcessed);
        Inc(FSizeProcessed);
        FOnProgress(self, FFilesProcessed, FFileCount, FSizeProcessed, FSizeCount);
      end;
    end;
  end;
end;

function TDFUnRar.ProcessFile(hArcData: THandle; Operation: Integer;
  DestPath, DestName: PChar): Integer;
var
  FileName: string;
  IsDirectory: boolean;
  CanOverride: boolean;
begin
  Result := 0;
  if FOverrideEvent = OR_ALWAYS then
    Result := RARProcessFile(hArcData, Operation, DestPath, DestName)
  else
  begin
    IsDirectory := (hdrData.Flags and $00000070) = $00000070;
    FileName := DestPath + '\' + StrPas(hdrData.FileName);

    if FFileList.Count > 0 then
      if FFileList.IndexOf(FileName) = -1 then
      begin
        Result := RARProcessFile(hArcData, RAR_SKIP, DestPath, DestName);
        exit;
      end;

    if not IsDirectory then
    begin
      if FileExists(FileName) and (Operation = RAR_EXTRACT) then
      begin
        case FOverrideEvent of
          OR_NEVER: Result := RARProcessFile(hArcData, RAR_SKIP, DestPath, DestName);
          OR_EVENT: begin
                      CanOverride := false;
                      if assigned(FOnOverride) then
                        FOnOverride(self, FileName, CanOverride);
                      if CanOverride then
                        Result := RARProcessFile(hArcData, Operation, DestPath, DestName)
                      else
                        Result := RARProcessFile(hArcData, RAR_SKIP, DestPath, DestName);
                    end;
        end;
      end
      else
        Result := RARProcessFile(hArcData, Operation, DestPath, DestName);
    end
    else
      Result := RARProcessFile(hArcData, Operation, DestPath, DestName);
  end;
end;

procedure TDFUnRar.ShowPasswordDialog(var Passwd: string);
var
  btnOk: TButton;
  btnCancel: TButton;
  edtPass: TEdit;
begin
  frmPass := TForm.Create(nil);
  try
    with frmPass do
    begin
      Left := 192;
      Top := 107;
      BorderStyle := bsDialog;
      Caption := PASSDLGCAPTION;
      ClientHeight := 69;
      ClientWidth := 168;
      Color := clBtnFace;
      Position := poScreenCenter;
    end;

    edtPass := TEdit.Create(frmPass);
    with edtPass do
    begin
      Parent := frmPass;
      Left := 8;
      Top := 8;
      Width := 153;
      Height := 21;
      MaxLength := 120;
      PasswordChar := '*';
      TabOrder := 0;
    end;

    btnOk := TButton.Create(frmPass);
    with btnOk do
    begin
      Parent := frmPass;
      Left := 7;
      Top := 37;
      Width := 75;
      Height := 25;
      Caption := OKCAPTION;
      TabOrder := 1;
      Default := true;
      OnClick := btnPassDlgClick;
    end;

    btnCancel := TButton.Create(frmPass);
    with btnCancel do
    begin
      Parent := frmPass;
      Left := 87;
      Top := 37;
      Width := 75;
      Height := 25;
      Caption := CANCELCAPTION;
      TabOrder := 2;
      OnClick := btnPassDlgClick;
    end;

    frmPass.ShowModal;
    PassWd := edtPass.Text;
  finally
    frmPass.Release;
  end;
end;

procedure TDFUnRar.btnPassDlgClick(Sender: TObject);
begin
  if (Sender as TButton).Name = 'btnOk' then
    frmPass.ModalResult := mrOk
  else
    frmPass.ModalResult := mrCancel;
end;

procedure TDFUnRar.CalcProgress;
var
  ReadFileHeaderResult: integer;
  ReadFileResult: Integer;
begin
  if not IsLoaded then
  begin
    DoError(MSG4, 0);
    exit;
  end;

  FFileCount := 0;
  FSizeCount := 0;
  CommentResult := 0;

  with openArchiveStruc do
  begin
    OpenResult := 0; // Init with RAR_SUCCESS
    OpenMode   := RAR_TEST;
    ArcName := PChar(FileName);
    GetMem(Comment, MAXRARCOMMENTSIZE); // Max
    CmtBuf     := Comment;
    CmtBufSize := MAXRARCOMMENTSIZE;
    CmtSize    := FCommentSize;
    CmtState   := CommentResult;
  end;

  if FStopProcessing then
    exit;

  OpenRARArchive;
  try
    if FStopProcessing then
      exit;

    RARSetCallback(ArchiveHandle, UnRarCallBack, 0);
    SetRARPassword;

    ReadFileResult := RAR_SUCCESS;
    repeat
      ReadFileHeaderResult := RARReadHeader(ArchiveHandle, @hdrData);
      if ReadFileHeaderResult = ERAR_END_ARCHIVE then
        break;

      if FStopProcessing then
        exit;

      if ReadFileHeaderResult = RAR_SUCCESS then
      begin
        ReadFileResult := RARProcessFile(ArchiveHandle, RAR_SKIP, PChar(Directory), nil);
        if ReadFileResult = RAR_SUCCESS then
        begin
          if not ((hdrData.Flags and $00000001) = $00000001) then
          begin
            Inc(FFileCount);
            FSizeCount := FSizeCount + hdrData.UnpSize;
          end;
        end;
      end;

      if StopProcessing then
        exit;
    until (ReadFileResult <> RAR_SUCCESS);
  finally
    CloseRARArchive;
  end;
end;

function TDFUnRar.Test: boolean;
var
  ReadFileHeaderResult: integer;
  ReadFileResult: Integer;
begin
  Result := false;

  if not IsLoaded then
  begin
    DoError(MSG4, 0);
    exit;
  end;

  CommentResult := 0;

  with openArchiveStruc do
  begin
    OpenResult := 0; // Init with RAR_SUCCESS
    OpenMode   := RAR_TEST;
    ArcName := PChar(FileName);
    GetMem(Comment, MAXRARCOMMENTSIZE); // Max
    CmtBuf     := Comment;
    CmtBufSize := MAXRARCOMMENTSIZE;
    CmtSize    := FCommentSize;
    CmtState   := CommentResult;
  end;

  if FStopProcessing then
    exit;

  OpenRARArchive;
  try
    if FStopProcessing then
      exit;

    RARSetCallback(ArchiveHandle, UnRarCallBack, 0);
    SetRARPassword;

    ReadFileResult := RAR_SUCCESS;
    repeat
      ReadFileHeaderResult := RARReadHeader(ArchiveHandle, @hdrData);
      if ReadFileHeaderResult = ERAR_END_ARCHIVE then
        break;

      if FStopProcessing then
        exit;

      if ReadFileHeaderResult = RAR_SUCCESS then
        ReadFileResult := ProcessFile(ArchiveHandle, RAR_OM_LIST, PChar(Directory), nil);

      if StopProcessing then
        exit;
    until (ReadFileResult <> RAR_SUCCESS);
  finally
    CloseRARArchive;
  end;
end;

function TDFUnRar.ShowPromptDialog(OldVolName: string; NewVolName: PChar): boolean;
var
  btnOk: TButton;
  btnCancel: TButton;
  edtVol: TEdit;
begin
  frmVol := TForm.Create(nil);
  try
    with frmVol do
    begin
      Left := 192;
      Top := 107;
      BorderStyle := bsDialog;
      Caption := VOLDLGCAPTION;
      ClientHeight := 69;
      ClientWidth := 168;
      Color := clBtnFace;
      Position := poScreenCenter;
    end;

    edtVol := TEdit.Create(frmVol);
    with edtVol do
    begin
      Parent := frmVol;
      Left := 8;
      Top := 8;
      Width := 153;
      Height := 21;
      MaxLength := 120;
      PasswordChar := #0;
      TabOrder := 0;
      Text := OldVolName;
    end;

    btnOk := TButton.Create(frmVol);
    with btnOk do
    begin
      Parent := frmVol;
      Left := 7;
      Top := 37;
      Width := 75;
      Height := 25;
      Caption := OKCAPTION;
      TabOrder := 1;
      Default := true;
      OnClick := btnVolDlgClick;
    end;

    btnCancel := TButton.Create(frmVol);
    with btnCancel do
    begin
      Parent := frmVol;
      Left := 87;
      Top := 37;
      Width := 75;
      Height := 25;
      Caption := CANCELCAPTION;
      TabOrder := 2;
      OnClick := btnVolDlgClick;
    end;

    Result := frmVol.ShowModal = mrOk;
    StrPCopy(NewVolName, edtVol.Text);
  finally
    frmVol.Release;
  end;
end;

procedure TDFUnRar.btnVolDlgClick(Sender: TObject);
begin
  if (Sender as TButton).Name = 'btnOk' then
    frmVol.ModalResult := mrOk
  else
    frmVol.ModalResult := mrCancel;
end;

end.