unit1.pas

文件加密压缩解压缩系统

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls, Menus, ExtCtrls, StdCtrls,inifiles, ShellApi,
  ToolWin, CheckLst, ShellCtrls,Registry;

type
  PFileSy = ^TFileSy;
  TFileSy=Record
    ChsName: string[200];
    Exefile: string[200];
    AClass: string[200];
    ImageIndex: ShortInt;
    Info: STRING[255];
    LinkText: string[200];
  end;
  TForm1 = class(TForm)
    picbox: TImageList;
    Panel1: TPanel;
    SB: TStatusBar;
    ScrollBox1: TScrollBox;
    ImageList1: TImageList;
    ImageList2: TImageList;
    ImageList3: TImageList;
    Panel2: TPanel;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    Panel3: TPanel;
    Bevel1: TBevel;
    Panel4: TPanel;
    Bevel2: TBevel;
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    O2: TMenuItem;
    N7: TMenuItem;
    R2: TMenuItem;
    N9: TMenuItem;
    N6: TMenuItem;
    N10: TMenuItem;
    ShellListView1: TShellListView;
    ShellTreeView1: TShellTreeView;
    D2: TMenuItem;
    T1: TMenuItem;

   procedure PopupMenu1Popup(Sender: TObject);
    procedure exitClick(Sender: TObject);
     procedure ProductClick(Sender: TObject);
    procedure httpwwwjxspringcommainasp1Click(Sender: TObject);
    procedure httpwwwjxspringcombbscom1Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure R2Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure O2Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure D2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);

    procedure ShellListView1MouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure T1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ShellListView1Click(Sender: TObject);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  APath,
  AInifile,
  ADatfile: string;
  AClass: TStrings;
  cClass: string;
  i:integer; //file number
  name:string;//path

implementation

uses ZLib;

{$R *.dfm}
(*//
标题:流的压缩和解压
说明:适用文件压缩、图象压缩等;调用ZLib单元的方法实现
设计:luochunlin
支持:13888985407
日期:2004-03-24
//*)

(*//============================================================================
设计思路:
创建TCompressionStream、TDecompressionStream实例进行压缩和解压
============================================================================//*)

const cBufferSize = $4096;

function StreamCompression(mInputStream: TStream; mOutputStream: TStream): Integer;
var
  I: Integer;
  vBuffer: array[0..cBufferSize]of Char;
begin
  Result := -1;
  if not (Assigned(mInputStream) and Assigned(mOutputStream)) then Exit;
  with TCompressionStream.Create(clMax, mOutputStream) do try
    for I := 1 to mInputStream.Size div cBufferSize do begin
      mInputStream.Read(vBuffer, cBufferSize);
      Write(vBuffer, cBufferSize);
    end;
    I := mInputStream.Size mod cBufferSize;
    if I > 0 then begin
      mInputStream.Read(vBuffer, I);
      Write(vBuffer, I);
    end;
  finally
    Free;
  end;
end;

function StreamDecompression(mInputStream: TStream; mOutputStream: TStream): Integer;
var
  vBuffer: array[0..cBufferSize]of Char;
  I: Integer;
begin
  Result := -1;
  if not (Assigned(mInputStream) and Assigned(mOutputStream)) then Exit;
  with TDecompressionStream.Create(mInputStream) do try
    repeat
      I := Read(vBuffer, cBufferSize);
      mOutputStream.Write(vBuffer, I);
    until I = 0;
    Result := mOutputStream.Size;
  finally
    Free;
  end;
end;


procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
ShellListView1Click(Sender);
end;

procedure TForm1.exitClick(Sender: TObject);
begin
  Close;
end;


procedure TForm1.ProductClick(Sender: TObject);
begin
  ShellAbout(Handle,'文件加密压缩解压缩系统-作者:罗春林',nil,Application.Icon.Handle);
end;

procedure TForm1.httpwwwjxspringcommainasp1Click(Sender: TObject);
begin
  ShellExecute(Handle,'open','mailto:[e-mail]',nil,nil,sw_normal);
end;

procedure TForm1.httpwwwjxspringcombbscom1Click(Sender: TObject);
begin
  ShellExecute(Handle,'open','mailto:[e-mail]',nil,nil,sw_normal);
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
  ShellExecute(Handle,'open','mailto:[e-mail]',nil,nil,sw_normal);
end;

procedure TForm1.R2Click(Sender: TObject);
begin
ShellListView1.Refresh;
end;

procedure TForm1.N6Click(Sender: TObject);
var
  vInputStream: TFileStream;
  vOutputStream: TFileStream;
begin
  vInputStream := TFileStream.Create(sb.Panels[2].Text, fmOpenRead);
  vOutputStream := TFileStream.Create(sb.Panels[2].Text+'.arm', fmCreate);
  try
    StreamCompression(vInputStream, vOutputStream);
  finally
    vInputStream.Free;
    vOutputStream.Free;
  end;
ShellListView1.Refresh;
end;

procedure TForm1.O2Click(Sender: TObject);
begin
   ShellExecute(Handle,'open',Pchar(sb.Panels[2].Text),nil,Pchar(ExtractFilePath(sb.Panels[2].Text)),sw_normal);
end;

procedure TForm1.N10Click(Sender: TObject);
var
  vInputStream: TFileStream;
  vOutputStream: TFileStream;
begin
  vInputStream := TFileStream.Create(sb.Panels[2].Text, fmOpenRead);
  vOutputStream := TFileStream.Create(Copy(sb.Panels[2].Text,0,length(sb.Panels[2].Text)-4), fmCreate);
  try
    StreamDecompression(vInputStream, vOutputStream);
  finally
    vInputStream.Free;
    vOutputStream.Free;
  end;
ShellListView1.Refresh;
end;

procedure TForm1.D2Click(Sender: TObject);
begin
deletefile(sb.Panels[2].Text);
ShellListView1.Refresh;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
 ShellAbout(Handle,'文件加密压缩解压缩系统-作者:罗春林',nil,Application.Icon.Handle);
end;



procedure TForm1.ShellListView1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
num:integer;
begin
i:=0;

for num:=0 to ShellListView1.Items.Count -1 do begin
  if ShellListView1.Items[num].Selected = true then
  begin
   if not ShellListView1.SelectedFolder.IsFolder then
        begin
         sb.Panels[2].Text :=ShellListView1.Folders[num].PathName;
         PopupMenu1.Items[0].Enabled :=true;
         PopupMenu1.Items[1].Enabled :=true;
         PopupMenu1.Items[3].Enabled :=true;
         PopupMenu1.Items[4].Enabled :=true;
         PopupMenu1.Items[5].Enabled :=true;
        end
   else
        begin
         PopupMenu1.Items[0].Enabled :=false;
         PopupMenu1.Items[1].Enabled :=false;
         PopupMenu1.Items[3].Enabled :=false;
         PopupMenu1.Items[4].Enabled :=false;
         PopupMenu1.Items[5].Enabled :=false;
        end;

     i:=i+1;
   end;
  end;

sb.Panels[1].Text := '选择了'+inttostr(i)+'项';

end;

procedure TForm1.T1Click(Sender: TObject);
const
  cMyExt = '.arm';
  cMyFileType = 'ArmyLife.exe';
var
  Reg:TRegistry;
begin
Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Reg.OpenKey(cMyExt, True);
    Reg.WriteString('', cMyFileType);
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType, True);
    Reg.WriteString('', 'ArmyLife File');
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType + '\DefaultIcon', True);
    Reg.WriteString('', Application.ExeName + ',0');
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType + '\Shell\Open', True);
    Reg.WriteString('', '&文件加密压缩解压缩(&A)');
    Reg.CloseKey;
    Reg.OpenKey(cMyFileType + '\Shell\Open\Command', True);
    Reg.WriteString('', '"' + Application.ExeName + '" "%1"');
    Reg.CloseKey;
    //SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
  finally
    Reg.Free;
    showmessage('.arm文件成功关联！');
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
filename:string;
begin
filename:=paramstr(1);//filename是txt文件双击后传给你的程序的文件名
if filename<>'' then  ShellListView1.Root:=ExtractFilePath(Paramstr(1));
end;

procedure TForm1.ShellListView1Click(Sender: TObject);
var
num:integer;
begin
i:=0;

for num:=0 to ShellListView1.Items.Count -1 do begin
  if ShellListView1.Items[num].Selected = true then
  begin
   if not ShellListView1.SelectedFolder.IsFolder then
        begin
         sb.Panels[2].Text :=ShellListView1.Folders[num].PathName;
         PopupMenu1.Items[0].Enabled :=true;
         PopupMenu1.Items[1].Enabled :=true;
         PopupMenu1.Items[3].Enabled :=true;
         PopupMenu1.Items[4].Enabled :=true;
         PopupMenu1.Items[5].Enabled :=true;
        end
   else
        begin
         PopupMenu1.Items[0].Enabled :=false;
         PopupMenu1.Items[1].Enabled :=false;
         PopupMenu1.Items[3].Enabled :=false;
         PopupMenu1.Items[4].Enabled :=false;
         PopupMenu1.Items[5].Enabled :=false;
        end;

     i:=i+1;
   end;
  end;

sb.Panels[1].Text := '选择了'+inttostr(i)+'项';

end;

end.