www.pudn.com > encryptdll3.6.1.rar > Reg.pas

{ 
------------------------------------------------------------------ 
=  Reg.dll ---- 共享软件加密函数库                               = 
=  Copyright (c) 2002-2003 liangs Studio, All rights reserved    = 
=  Created 2004/04/24 by liangs                                  = 
=  Version: 3.4                                                  = 
=  Homepage: http://liangs99.yeah.net                         = 
=  Email: liang_sheng@163.net                                    = 
------------------------------------------------------------------ 
 
------------------------------------------------------------------ 
=  Reg.pas ---- 共享软件加密函数库Delphi调用模块                 = 
=  Copyright (c) 2002-2003 DreamRing Studio, All rights reserved = 
=  Created 2003/09/04 by dingdangy(梦叮当)                       = 
=  Version: 3.2                                                  = 
=  Homepage: http://www.dreamring.9126.com                       = 
=  Email: dingdangy@163.com(梦叮当)                              = 
------------------------------------------------------------------ 
} 
 
unit Reg; 
 
interface 
 
uses 
  Windows, Messages, Classes, Graphics, Controls, Dialogs; 
 
type 
  myCharArray = array of Char; 
 
procedure GetHardDiskId(); 
procedure MD5Encrypt(lpInBuffer:PChar; length:Integer); 
procedure BlowFishEncrypt(lpInBuffer:PChar; lpKey:PChar); 
procedure BlowFishDecrypt(lpInBuffer:PChar; lpKey:PChar); 
procedure SHAEncrypt(lpInBuffer:PChar; length:Integer); 
procedure Secret16Encrypt(lpInBuffer:PChar; lpKey:PChar); 
procedure EncryptStringFun1(lpInBuffer:PChar; lpKey:PChar); 
procedure DecryptStringFun1(lpInBuffer:PChar; lpKey:PChar); 
procedure EncryptStringFun2(lpInBuffer:PChar; lpKey:PChar); 
procedure DecryptStringFun2(lpInBuffer:PChar; lpKey:PChar); 
procedure RSAEncrypt(lpInBuffer:PChar; lpDdata:PChar; lpNdata:PChar; Mode:Integer); 
procedure RSADecrypt(lpInBuffer:PChar; lpNdata:PChar; Mode:Integer); 
procedure CRCFileCheck(FileNameStr:PChar); 
procedure FileEncrypt(lpInputFileName:PChar; lpOutputFileName:PChar; lpKey:PChar); 
procedure FileDecrypt(lpInputFileName:PChar; lpOutputFileName:PChar; lpKey:PChar); 
procedure Base64Encode(lpInBuffer:PChar); 
procedure Base64Decode(lpInBuffer:PChar); 
procedure CRC32(lpInBuffer:PChar; length:Integer); 
procedure GetDllVersion(); 
procedure GetMainBoardId(); 
procedure DesEncrypt(lpInBuffer:PChar; lpKey:PChar); 
procedure DesDecrypt(lpInBuffer:PChar; lpKey:PChar); 
 
var 
  hlib: HMODULE; 
  lpRegisterCode: PChar; 
  Return: String; 
implementation 
   
procedure Initialize; 
begin 
  hlib:= LoadLibrary('Reg.dll'); 
  lpRegisterCode:= 'user-123456'; 
end; 
 
procedure GetHardDiskId(); 
{获取磁盘物理序列号} 
var 
  GetHardDiskId: function(lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  DiskID: array [0..30] of Char; 
begin 
  FillChar(DiskID, SizeOf(DiskID), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @GetHardDiskId := GetProcAddress(hLib, 'GetHardDiskId'); 
    if @GetHardDiskId <> nil then begin 
      if GetHardDiskId(DiskID, lpRegisterCode) then 
        Return := DiskID 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure MD5Encrypt(lpInBuffer:PChar; length:Integer); 
{MD5 加密} 
var 
  MD5Encrypt: function(lpInBuffer:PChar; lpOutBuffer:PChar; length:Integer; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..32] of Char; 
begin 
  FillChar(OutputStr, SizeOf(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @MD5Encrypt := GetProcAddress(hlib, 'MD5Encrypt'); 
    if @MD5Encrypt <> nil then begin 
      if MD5Encrypt(lpInBuffer, OutputStr, length, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure BlowFishEncrypt(lpInBuffer:PChar; lpKey:PChar); 
{BlowFish 加密} 
var 
  BlowFishEncrypt: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..200] of Char;//输出长度请参考帮助文件 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @BlowFishEncrypt := GetProcAddress(hlib, 'BlowFishEncrypt'); 
    if @BlowFishEncrypt <> nil then begin 
      if BlowFishEncrypt(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure BlowFishDecrypt(lpInBuffer:PChar; lpKey:PChar); 
{BlowFish 解密} 
var 
  BlowFishDecrypt: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..200] of Char;//输出长度请参考帮助文件 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @BlowFishDecrypt := GetProcAddress(hlib, 'BlowFishDecrypt'); 
    if @BlowFishDecrypt <> nil then begin 
      if BlowFishDecrypt(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure SHAEncrypt(lpInBuffer:PChar; length:Integer); 
{SHA 加密} 
var 
  SHAEncrypt: function(lpInBuffer:PChar; lpOutBuffer:PChar; length:Integer; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..129] of Char; 
begin 
  FillChar(OutputStr, SizeOf(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @SHAEncrypt := GetProcAddress(hlib, 'SHAEncrypt'); 
    if @SHAEncrypt <> nil then begin 
      if SHAEncrypt(lpInBuffer, OutputStr, length, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure Secret16Encrypt(lpInBuffer:PChar; lpKey:PChar); 
{Secret16 加密} 
var 
  Secret16Encrypt: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..16] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @Secret16Encrypt := GetProcAddress(hlib, 'Secret16Encrypt'); 
    if @Secret16Encrypt <> nil then begin 
      if Secret16Encrypt(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure EncryptStringFun1(lpInBuffer:PChar; lpKey:PChar); 
{String 加密1} 
var 
  EncryptStringFun1: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..8192] of Char;//此处定义了输出缓冲允许的最大范围，您可以根据自己的实际情况定义范围。 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @EncryptStringFun1 := GetProcAddress(hlib, 'EncryptStringFun1'); 
    if @EncryptStringFun1 <> nil then begin 
      if EncryptStringFun1(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure DecryptStringFun1(lpInBuffer:PChar; lpKey:PChar); 
{String 解密1} 
var 
  DecryptStringFun1: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..4096] of Char;//此处定义了输出缓冲允许的最大范围，您可以根据自己的实际情况定义范围。 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @DecryptStringFun1 := GetProcAddress(hlib, 'DecryptStringFun1'); 
    if @DecryptStringFun1 <> nil then begin 
      if DecryptStringFun1(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure EncryptStringFun2(lpInBuffer:PChar; lpKey:PChar); 
{String 加密2} 
var 
  EncryptStringFun2: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..32] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @EncryptStringFun2 := GetProcAddress(hlib, 'EncryptStringFun2'); 
    if @EncryptStringFun2 <> nil then begin 
      if EncryptStringFun2(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure DecryptStringFun2(lpInBuffer:PChar; lpKey:PChar); 
{String 解密2} 
var 
  DecryptStringFun2: function(lpInBuffer:PChar; lpKey:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..16] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @DecryptStringFun2 := GetProcAddress(hlib, 'DecryptStringFun2'); 
    if @DecryptStringFun2 <> nil then begin 
      if DecryptStringFun2(lpInBuffer, lpKey, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure RSAEncrypt(lpInBuffer:PChar; lpDdata:PChar; lpNdata:PChar; Mode:Integer); 
{RSA 加密} 
var 
  RSAEncrypt: function(lpInBuffer:PChar; lpDdata:PChar; lpNdata:PChar; Mode:Integer; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..256] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @RSAEncrypt := GetProcAddress(hlib, 'RSAEncrypt'); 
    if @RSAEncrypt <> nil then begin 
      if RSAEncrypt(lpInBuffer, lpDdata, lpNdata, Mode, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure RSADecrypt(lpInBuffer:PChar; lpNdata:PChar; Mode:Integer); 
{RSA 解密} 
var 
  RSADecrypt: function(lpInBuffer:PChar; lpNdata:PChar; Mode:Integer; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..256] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @RSADecrypt := GetProcAddress(hlib, 'RSADecrypt'); 
    if @RSADecrypt <> nil then begin 
      if RSADecrypt(lpInBuffer, lpNdata, Mode, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure CRCFileCheck(FileNameStr:PChar); 
{CRC 文件校验} 
var 
  CRCFileCheck: function(FileNameStr:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..32] of Char; 
begin 
  FillChar(OutputStr, SizeOf(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @CRCFileCheck := GetProcAddress(hLib, 'CRCFileCheck'); 
    if @CRCFileCheck <> nil then begin 
      if CRCFileCheck(FileNameStr, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure FileEncrypt(lpInputFileName:PChar; lpOutputFileName:PChar; lpKey:PChar); 
{文件加密} 
var 
  FileEncrypt: function(lpInputFileName:PChar; lpOutputFileName:PChar; lpKey:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
begin 
  Initialize; 
  if hlib <> 0 then begin 
    @FileEncrypt := GetProcAddress(hLib, 'FileEncrypt'); 
    if @FileEncrypt <> nil then begin 
      if FileEncrypt(lpInputFileName, lpOutputFileName, lpKey, lpRegisterCode) then 
        Return := '加密成功！' 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure FileDecrypt(lpInputFileName:PChar; lpOutputFileName:PChar; lpKey:PChar); 
{文件解密} 
var 
  FileDecrypt: function(lpInputFileName:PChar; lpOutputFileName:PChar; lpKey:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
begin 
  Initialize; 
  if hlib <> 0 then begin 
    @FileDecrypt := GetProcAddress(hLib, 'FileDecrypt'); 
    if @FileDecrypt <> nil then begin 
      if FileDecrypt(lpInputFileName, lpOutputFileName, lpKey, lpRegisterCode) then 
        Return := '解密成功！' 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure Base64Encode(lpInBuffer:PChar); 
{Base64 加密} 
var 
  Base64Encode: function(lpInBuffer:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..200] of Char;//输出长度请参考帮助文件 
begin 
  FillChar(OutputStr, SizeOf(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @Base64Encode := GetProcAddress(hLib, 'Base64Encode'); 
    if @Base64Encode <> nil then begin 
      if Base64Encode(lpInBuffer, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure Base64Decode(lpInBuffer:PChar); 
{Base64 解密} 
var 
  Base64Decode: function(lpInBuffer:PChar; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..200] of Char;//输出长度请参考帮助文件 
begin 
  FillChar(OutputStr, SizeOf(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @Base64Decode := GetProcAddress(hLib, 'Base64Decode'); 
    if @Base64Decode <> nil then begin 
      if Base64Decode(lpInBuffer, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure CRC32(lpInBuffer:PChar; length:Integer); 
{CRC32 校验} 
var 
  CRC32: function(lpInBuffer:PChar; length:Integer; lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..32] of Char; 
begin 
  FillChar(OutputStr, SizeOf(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @CRC32 := GetProcAddress(hlib, 'CRC32'); 
    if @CRC32 <> nil then begin 
      if CRC32(lpInBuffer, length, OutputStr, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure GetDllVersion(); 
{获取当前 Reg.dll 版本号} 
var 
  GetDllVersion: function(lpOutBuffer:PChar): Boolean;  stdcall; 
  DllVersion: array [0..10] of Char; 
begin 
  FillChar(DllVersion, SizeOf(DllVersion), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @GetDllVersion := GetProcAddress(hLib, 'GetDllVersion'); 
    if @GetDllVersion <> nil then begin 
      if GetDllVersion(DllVersion) then 
        Return := DllVersion 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
//3.2版本新增函数 
procedure GetMainBoardId(); 
{获取主板序列号} 
var 
  GetMainBoardId: function(lpOutBuffer:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  MainBoardId: array [0..50] of Char; 
begin 
  FillChar(MainBoardId, SizeOf(MainBoardId), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @GetMainBoardId := GetProcAddress(hLib, 'GetMainBoardId'); 
    if @GetMainBoardId <> nil then begin 
      if GetMainBoardId(MainBoardId, lpRegisterCode) then 
        Return := MainBoardId 
      else 
        Return := '函数调用错误！' 
    end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hLib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure DesEncrypt(lpInBuffer:PChar; lpKey:PChar); 
{Des 加密} 
var 
  DesEncrypt: function(lpInBuffer:PChar; lpOutBuffer:PChar; lpKey:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..500] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @DesEncrypt := GetProcAddress(hlib, 'DesEncrypt'); 
    if @DesEncrypt <> nil then begin 
      if DesEncrypt(lpInBuffer, OutputStr, lpKey, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
procedure DesDecrypt(lpInBuffer:PChar; lpKey:PChar); 
{Des 解密} 
var 
  DesDecrypt: function(lpInBuffer:PChar; lpOutBuffer:PChar; lpKey:PChar; lpRegisterCode:PChar): Boolean;  stdcall; 
  OutputStr: array [0..500] of Char; 
begin 
  FillChar(OutputStr, Sizeof(OutputStr), #0); 
  Initialize; 
  if hlib <> 0 then begin 
    @DesDecrypt := GetProcAddress(hlib, 'DesDecrypt'); 
    if @DesDecrypt <> nil then begin 
      if DesDecrypt(lpInBuffer, OutputStr, lpKey, lpRegisterCode) then 
        Return := OutputStr 
      else 
        Return := '函数调用错误！' 
      end 
    else 
      ShowMessage('加载功能模块出错！'); 
 
    FreeLibrary(hlib); 
  end 
  else 
    ShowMessage('无法加载DLL！'); 
end; 
 
end.