dlgtext.pas

编写

unit DlgText;

{$R-}

interface

uses Messages, Windows, SysUtils, Classes, Controls, StdCtrls, Graphics,
	 ExtCtrls, Dialogs, ComCtrls, unzip32;

type

{ TOpenTextDialog }
  TOpenTextDialog = class(TOpenDialog)
  private
    FTextPanel : TPanel;
    FPosPanel : Tpanel;
    FCheckPanel : TPanel;
    FText: TMemo;
    FCheckBig5 : TCheckBox;
//  FText: TRichEdit;
  protected
    PreviewText : string;
    procedure DoClose; override;
	procedure DoShow; override;
    procedure DoSelectionChange; override;
    procedure CheckBig5Click(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;
  end;

{ TSaveTextDialog }
  TSaveTextDialog = class(TOpenTextDialog)
  public
    function Execute: Boolean; override;
  end;

var FileCount : integer;
    zipFileName : string;
    mText : TMemo;

procedure Set_UnZipOptions(var O: TDCL);
procedure Set_UserFunctions(var Z: TUserFunctions);

function DllPrnt(Buffer: PChar; Size: ULONG): integer; stdcall;
function DllPassword(P: PChar; N: Integer; M, Name: PChar): integer; stdcall;
function DllService(CurFile: PChar; Size: ULONG): integer; stdcall;
function DllReplace(FileName: PChar): integer; stdcall;
procedure DllMessage(UnCompSize : ULONG;
                     CompSize   : ULONG;
                     Factor     : UINT;
                     Month      : UINT;
                     Day        : UINT;
                     Year       : UINT;
                     Hour       : UINT;
                     Minute     : UINT;
                     C          : Char;
                     FileName   : PChar;
					 MethBuf    : PChar;
                     CRC        : ULONG;
                     Crypt      : Char); stdcall;

               implementation

uses Forms, CommDlg, Dlgs, gb2big5, main;

{ TOpenTextDialog }

constructor TOpenTextDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  PreviewText := '';

  FTextPanel := TPanel.Create(Self);
  with FTextPanel do
  begin
	   Name := 'TextPanel';

       with Font do
       begin
			Charset:=GB2312_CHARSET;
            Color:=clWindowText;
            Height:=-15;
            Name:='宋体';
            Pitch:=fpDefault;
            Size:=9;
            Style:=[];
       end;

	   Caption := '';
	   SetBounds(204, 5, 180, 220);
	   BevelInner := bvNone;
	   BevelOuter := bvNone;
	   BorderWidth := 0;
	   TabOrder := 1;

       FPosPanel := TPanel.Create(Self);
       with FPosPanel do
       begin
            Name:='PosPanel';
	        Caption := '';
            Width:=5;
	        BevelInner := bvNone;
	        BevelOuter := bvNone;
	        BorderWidth := 0;
	        TabOrder := 0;
            Align := alRight;
            Parent := FTextPanel;
       end;

       FCheckPanel := TPanel.Create(Self);
       with FCheckPanel do
       begin
            Name:='CheckPanel';
	        Caption := '';
            Height:=25;
	        BevelInner := bvNone;
	        BevelOuter := bvNone;
	        BorderWidth := 0;
	        TabOrder := 1;
            Align := alBottom;
            Parent := FTextPanel;

            FCheckBig5 := TCheckBox.Create(Self);
            with FCheckBig5 do
            begin
                 Name := 'CheckBig5';
                 Caption := '&BIG5码';
                 SetBounds(0, 2, 100, 20);
                 Taborder := 0;
                 Parent := FCheckPanel;
                 OnClick := CheckBig5Click;
            end;
       end;

       FText := TMemo.Create(Self);
//	   FText := TRichEdit.Create(Self);
	   with FText do
	   begin
	        Name := 'Text';
            Text := '';
            Ctl3D:=True;
            ReadOnly:=True;
            ScrollBars:=ssVertical;
            TabOrder := 2;
            Align := alClient;
            Parent := FTextPanel;
       end;
  end;
end;

destructor TOpenTextDialog.Destroy;
begin
  FText.Free;

  FCheckBig5.Free;
  FCheckPanel.Free;

  FPosPanel.Free;

  FTextPanel.Free;
  inherited Destroy;
end;

procedure TOpenTextDialog.CheckBig5Click(Sender: TObject);
begin
  if FCheckBig5.Checked then
     FText.Text:=BIG5toGB(PreviewText)
  else
     FText.Text:=PreviewText;
end;

procedure TOpenTextDialog.DoSelectionChange;
var UF : TUserFunctions;
	Opt  : TDCL;

    FullName: string;
    ValidPicture: Boolean;
    fp : File;  //文件指针
    DataBuf : array [1..2000] of Char;  //读文件缓冲
    Readnum : Longint;  //实际读文件长度大小
    ClearIndex : integer;

  function ValidFile(const FileName: string): Boolean;
  begin
    Result := GetFileAttributes(PChar(FileName)) <> $FFFFFFFF;
  end;

begin
  FullName := FileName;

  PreviewText := '';
  FText.Text:=PreviewText;
  FTextPanel.Refresh;

  ValidPicture := FileExists(FullName) and ValidFile(FullName);
  if ValidPicture then
	 try
        if f_main.Get_Filename_Ext(FullName)='zip' then
        begin  //预览zip文件
             if not IsExpectedUnZipDllVersion then
                exit;

             mText:=FText;
             zipFileName:=FullName;
             FileCount:=0;

             Set_UserFunctions(UF);
             Set_UnZipOptions(Opt);

             Wiz_SingleEntryUnzip(0,    { number of file names being passed }
			      		          nil,  { file names to be unarchived }
					              0,    { number mes to be excluded from the unarchiving process }
					              nil,  { pointer of "file names to be excluded from processing" being  passed }
					              Opt,  { file nato a structure with the flags for setting the  various options }
					              UF);  { pointer to a structure that contains pointers to user functions }

        end
        else
        begin  //预览一般文件
             for ClearIndex:=1 to 2000 do DataBuf[ClearIndex]:=#0;

             AssignFile(fp,FullName);
             FileMode:=0;
             Reset(fp,1);
             BlockRead(fp,DataBuf,SizeOf(DataBuf),Readnum);
             PreviewText:=DataBuf;
             CloseFile(fp);

             CheckBig5Click(nil);
        end;
	 except
		ValidPicture := False;
	 end;

  FTextPanel.Refresh;

  if not ValidPicture then
  begin
	   FText.Text:='';
  end;

  inherited DoSelectionChange;
end;

procedure TOpenTextDialog.DoClose;
begin
  inherited DoClose;
  { Hide any hint windows left behind }
  Application.HideHint;
end;

procedure TOpenTextDialog.DoShow;
var PreviewRect, StaticRect: TRect;
begin
  { Set preview area to entire dialog }
  GetClientRect(Handle, PreviewRect);
  StaticRect := GetStaticRect;

  { Move preview area to right of static area }
  PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left);
  Inc(PreviewRect.Top, 4);
  FTextPanel.BoundsRect := PreviewRect;
  FTextPanel.ParentWindow := Handle;
  FText.Text:='';

  inherited DoShow;
end;

function TOpenTextDialog.Execute;
begin
  if NewStyleControls and not (ofOldStyleDialog in Options) then
     Template := 'DLGTEMPLATE'
  else
     Template := nil;
  Result := inherited Execute;
end;

{ TSaveTextDialog }

function TSaveTextDialog.Execute: Boolean;
begin
  if NewStyleControls and not (ofOldStyleDialog in Options) then
	 Template := 'DLGTEMPLATE'
  else
	 Template := nil;
  Result := DoExecute(@GetSaveFileName);
end;

{ Preview zip File }
function DllPrnt(Buffer: PChar; Size: ULONG): integer;
begin
  Result := Size;
end;

function DllPassword(P: PChar; N: Integer; M, Name: PChar): integer;
begin
  Result := 1;
end;

function DllService(CurFile: PChar; Size: ULONG): integer;
begin
  Result := 0;
end;

function DllReplace(FileName: PChar): integer;
begin
  Result := 1;
end;

procedure DllMessage(UnCompSize : ULONG;
                     CompSize   : ULONG;
                     Factor     : UINT;
                     Month      : UINT;
                     Day        : UINT;
                     Year       : UINT;
                     Hour       : UINT;
                     Minute     : UINT;
                     C          : Char;
                     FileName   : PChar;
					 MethBuf    : PChar;
					 CRC        : ULONG;
					 Crypt      : Char);
var sFileName : string;
	sPathName : string;
	cFileIndex : integer;
	cFileIndex1 : integer;
begin
  sFileName:=Filename;
  sPathName:='';

  //忽略目录
  if sFileName[Length(sFileName)]='/' then exit;

  for cFileIndex:=Length(sFileName) downto 1 do
  begin
	   if sFileName[cFileIndex]='/' then
	   begin
            //分割目录和文件
			sPathName:=copy(sFileName,1,cFileIndex);
			sFileName:=copy(sFileName,cFileIndex+1,Length(sFileName));

			cFileIndex1:=pos('/',sPathName);
			while cFileIndex1>0 do
			begin
				 sPathName[cFileIndex1]:='\';
				 cFileIndex1:=pos('/',sPathName);
			end;

            //文件数+1
            inc(FileCount);
            MText.Lines.Add(sFileName);

			exit;
	   end;
  end;

  //文件数+1
  inc(FileCount);
  MText.Lines.Add(sFileName);
end;

procedure Set_UserFunctions(var Z:TUserFunctions);
begin
  with Z do
  begin
	   @Print                  := @DllPrnt;
	   @Sound                  := nil;
	   @Replace                := @DllReplace;
	   @Password               := @DllPassword;
	   @SendApplicationMessage := @DllMessage;
	   @ServCallBk             := @DllService;
  end;
end;

procedure Set_UnZipOptions(var O: TDCL);
begin
  with O do
  begin
	   ExtractOnlyNewer  := 0;
	   SpaceToUnderscore := 0;
	   PromptToOverwrite := 0;
	   fQuiet            := 0;
	   nCFlag            := 0;
	   nTFlag            := 0;
	   nVFlag            := 1;  //浏览
	   nUFlag            := 0;
	   nZFlag            := 0;
	   nDFlag            := 1;  //带目录
	   nOFlag            := 0;
	   nAFlag            := 0;
	   nZIFlag           := 0;
	   C_flag            := 0;
	   fPrivilege        := 1;
	   lpszZipFN         := PChar(ZipFileName);
	   lpszExtractDir    := PChar('');
  end;
end;

end.