func.pas

文件加密发生法

unit Func;

interface

uses Windows, Forms, SysUtils, Registry, ShlObj, Activex, ComObj, Encrypt_Base64;

function GetPassWord:String;
procedure PutPassWord(sPutPass:String);
function NeedPass(Test,Need:Boolean):Boolean;
function GetCompress(Test,Comp:Boolean):Boolean;
function AssocExeFile(Test,Op:Boolean; DispString:String):Boolean;
function GetShortcutTarget(ShortcutFileName:String):String;

const
  MyKey='\SOFTWARE\ExeLock';

implementation

function GetPassWord:String;
var
  MyReg:TRegistry;
begin
  Result:='';
  MyReg:=TRegistry.Create ;
  with MyReg do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      if OpenKey(MyKey,False) then
        Result:=Base64Decode(ReadString('PassWord'));
      CloseKey;
    finally
      Free;
    end;
  end;
end;

procedure PutPassWord(sPutPass:String);
var
  MyReg:TRegistry;
begin
  MyReg:=TRegistry.Create ;
  with MyReg do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      OpenKey(MyKey,True);
      WriteString('PassWord',Base64Encode(sPutPass));
      CloseKey;
    finally
      Free;
    end;
  end;
end;

function GetCompress(Test,Comp:Boolean):Boolean;
var
  MyReg:TRegistry;
begin
  Result:=False;
  MyReg:=TRegistry.Create;
  with MyReg do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      OpenKey(MyKey,True);
      if Test then
      begin
        if ValueExists('Compressed') then
          Result:=ReadBool('Compressed');
      end
      else
        WriteBool('Compressed',Comp);
      CloseKey;
    finally
      Free;
    end;
  end;
end;

function NeedPass(Test,Need:Boolean):Boolean;
var
  MyReg:TRegistry;
begin
  Result:=False;
  MyReg:=TRegistry.Create;
  with MyReg do
  begin
    try
      RootKey:=HKEY_LOCAL_MACHINE;
      OpenKey(MyKey,True);
      if Test then
      begin
        if ValueExists('NeedPassWord') then
          Result:=ReadBool('NeedPassWord');
      end
      else
        WriteBool('NeedPassWord',Need);
      CloseKey;
    finally
      Free;
    end;
  end;
end;

function AssocExeFile(Test,Op:Boolean; DispString:String):Boolean;
var
  MyReg:TRegistry;
  ExeKey:String;
begin
  Result:=False;
  MyReg:=TRegistry.Create;
  with MyReg do
  begin
    try
      RootKey:=HKEY_CLASSES_ROOT;
      ExeKey:='\exefile\Shell\'+DispString;
      if Test then
      begin
        Result:=KeyExists(ExeKey);
      end else
      if Op then
      begin{Add}
        OpenKey(ExeKey+'\Command',True);
        WriteString('',Application.ExeName+' "%1"');
      end else
      begin{Delete}
        OpenKey(ExeKey,False);
        DeleteKey(ExeKey);
      end;
    finally
      Free;
    end;
  end;
end;

function GetShortcutTarget(ShortcutFileName:String):String;
var
  Psl:IShellLink;
  Ppf:IPersistFile;
  WideName:Array [0..MAX_PATH-1] of WideChar;
  pResult:Array [0..MAX_PATH-1] Of Char;
  Data:TWin32FindData;
const
  IID_IPersistFile:TGUID=(D1:$0000010B; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
begin
  CoCreateInstance(CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER, IID_IShellLinkA ,psl);
  psl.QueryInterface(IID_IPersistFile,ppf);
  MultiByteToWideChar(CP_ACP, 0, pChar(ShortcutFilename), -1, WideName, Max_Path);
  ppf.Load(WideName,STGM_READ);
  psl.Resolve(0,SLR_ANY_MATCH);
  psl.GetPath(@pResult,MAX_PATH,Data,SLGP_UNCPRIORITY);
  Result:=StrPas(@pResult);
end;

end.