哪位高手看一下这个代码

PYbaby0393 · 发表于 2010-10-22 23:14:17

以下是从某位坛友发的源码里得来的东西百度了一下发现是个智能监视系统源码，请高手详解

QQ截图未命名.jpg

{============================================================
*File          : CommonUnit                            *
*Version       : 1.0                                     *
*Comment       : 公共函数                               *
*Date          : 2003-07-26                            *
*Time          : 09:34:37                               *
*Author       : yxkjok                                  *
*Compiler    : yxkjok                                  *
*UpdateDateTime : 2003-07-26  10:55:52                   *
============================================================}
unit CommonUnit;
interface
uses
  Controls, Windows, Classes, Forms, IniFiles, Graphics, SysUtils,
  Contnrs, JPEG, nb30, ComObj, Registry;
type
  PASTAT = ^TASTAT;
  TASTAT = record
adapter: TAdapterStatus;
name_buf: TNameBuffer;
  end;
  {公共常量}

const
  StartKey = 897; {Start default key}
  MultKey = 58665; {Mult default key}
  AddKey = 28584; {Add default key}
const
  ID_BIT = $200000; // EFLAGS ID bit
type
  TCPUID = array[1..4] of Longint;
  TVendor = array[0..11] of char;
  {系统操作函数}
function GetTempDirectory: string; stdcall; //取得临时目录
{文件操作函数}
function CompressDataBase(SouceFile: string): Boolean; //压缩数据库
//-------------------------------------------------------------------
function IsCPUID_Available: Boolean; register; //看是否有可查的CPUID
function GetCPUID: TCPUID; assembler; register; //获取CPUID
function GetCPUVendor: TVendor; assembler; register; //获取CPU产商
function GetCPUIDStr: string; //计算CPUID
//-----------------------------------------------------------------
function GetClientRegCode(Str: string): string stdcall;
function Time_Encrypt(S: string; Time: Double): string; // 加密
function cl_Encrypt(S: string): string; //stdcall;
function cl_decrypt(S: string): string; //stdcall;
function Encrypt(const InString: string; StartKey, MultKey, AddKey: Int64): string;
function Decrypt(const InString: string; StartKey, MultKey, AddKey: Int64): string;
//--------------------------------
{注册表}
procedure WriteValueToReg(sValue: string);
function PartitionString(StrV, PrtSymbol: string): TStringList;
function ReadValueFromReg: string; //取MAC地址(集成网卡和非集成网卡):
function Getmac: string;
function MacStr(): string;
function ReadIni(Filename, Section, Value, Default: string): string;
function WriteIni(Filename, Section, Ident, Value: string): Boolean;
implementation
uses Unit1;

function ReadIni(Filename, Section, Value, Default: string): string;
var
  IniFile: TIniFile;
begin
  if FileExists(Filename) then begin
IniFile := TIniFile.Create(Filename);
try
   Result := IniFile.ReadString(Section, Value, Default);
finally
   FreeAndNil(IniFile);
end;
  end
  else
Result := Default;
end;
function WriteIni(Filename, Section, Ident, Value: string): Boolean;
var
  IniFile: TIniFile;
begin
  IniFile := TIniFile.Create(Filename);
  try
IniFile.WriteString(Section, Ident, Value);
  finally
FreeAndNil(IniFile);
  end;
end;

function Getmac: string;
var
  ncb: TNCB;
  S: string;
  adapt: TASTAT;
  lanaEnum: TLanaEnum;
  i, j, m: integer;
  strPart, strMac: string;
begin
  FillChar(ncb, SizeOf(TNCB), 0);
  ncb.ncb_command := char(NCBEnum);
  ncb.ncb_buffer := Pchar(@lanaEnum);
  ncb.ncb_length := SizeOf(TLanaEnum);
  S := Netbios(@ncb);
  for i := 0 to integer(lanaEnum.length) - 1 do begin
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana;
Netbios(@ncb);
Netbios(@ncb);
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Chr(NCBAstat);
ncb.ncb_lana_num := lanaEnum.lana;
ncb.ncb_callname := '*             ';
ncb.ncb_buffer := Pchar(@adapt);
ncb.ncb_length := SizeOf(TASTAT);
m := 0;
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
   m := 1;
if m = 1 then begin
   if Netbios(@ncb) = Chr(0) then
      strMac := '';
   for j := 0 to 5 do begin
      strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
      strMac := strMac + strPart + '-';
   end;
   SetLength(strMac, length(strMac) - 1);
end;
if m = 0 then
   if Netbios(@ncb) <> Chr(0) then begin
      strMac := '';
      for j := 0 to 5 do begin
      strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
      strMac := strMac + strPart + '-';
      end;
      SetLength(strMac, length(strMac) - 1);
   end;
  end;
  Result := strMac;
end;
function PartitionString(StrV, PrtSymbol: string): TStringList;
var
  iTemp: integer;
begin
  Result := TStringList.Create;
  iTemp := pos(PrtSymbol, StrV);
  while iTemp > 0 do begin
if iTemp > 1 then Result.Append(copy(StrV, 1, iTemp - 1));
delete(StrV, 1, iTemp + length(PrtSymbol) - 1);
iTemp := pos(PrtSymbol, StrV);
  end;
  if StrV <> '' then Result.Append(StrV);
end;
function MacStr(): string;
var
  Str: TStrings;
  i: integer;
  MacStr: string;
begin
  MacStr := '';
  Str := TStringList.Create;
  Str := PartitionString(Getmac, '-');
  for i := 0 to Str.Count - 1 do
MacStr := MacStr + Str;
  Result := MacStr;
end;

function ReadValueFromReg: string;
var
  Reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create;
  try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\yxkj', True) then begin
   if Reg.ValueExists('RegCode') then begin
      Result := Reg.ReadString('RegCode');
   end;
end;
  finally
Reg.CloseKey;
Reg.Free;
  end;
end;

procedure WriteValueToReg(sValue: string);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\yxkj', True) then
   Reg.WriteString('RegCode', sValue);
  finally
Reg.CloseKey;
Reg.Free;
  end;
end;
function cl_bytetocharstr(S: string): string;
var
  i: integer;
begin
  i := 1;
  Result := '';
  if (length(S) mod 3) = 0 then
while i < length(S) do begin
   Result := Result + char(strtoint(copy(S, i, 3)));
   i := i + 3;
end;
end;

function cl_intto0str(int1: Int64; len: Int64): string;
var
  i, j: integer;
begin
  if length(inttostr(int1)) >= len then
Result := inttostr(int1)
  else begin
Result := '';
i := len - length(inttostr(int1));
for j := 1 to i do Result := Result + '0';
Result := Result + inttostr(int1);
  end;
end;
function cl_chartobytestr(S: string): string;
var
  i: byte;
begin
  Result := '';
  for i := 1 to length(S) do
Result := Result + cl_intto0str(byte(S), 3);
end;
function Decrypt(const InString: string; StartKey, MultKey, AddKey: Int64): string;
var
  i: byte;
begin
  Result := '';
  for i := 1 to length(InString) do begin
Result := Result + char(byte(InString) xor (StartKey shr 8));
StartKey := (byte(InString) + StartKey) * MultKey + AddKey;
  end;
end;

{$R+}
{$Q+}
function cl_Encrypt(S: string): string;
var
  years, months, days, hours, mins, secs, msec: word;
  cl_StartKey, cl_MultKey, cl_AddKey: Longint;
begin
  decodedate(now, years, months, days);
  decodetime(now, hours, mins, secs, msec);
  cl_StartKey := msec;
  if cl_StartKey < 256 then cl_StartKey := cl_StartKey + 256;
  cl_MultKey := ((years - 1900) * 12 + months) * 30 + days + cl_StartKey * 10 + cl_StartKey;
  cl_AddKey := (23 * hours + mins) * 60 + secs + cl_StartKey * 10 + cl_StartKey;
  Result := cl_chartobytestr(Encrypt(cl_intto0str(cl_StartKey, 3), StartKey, MultKey, AddKey)) + cl_chartobytestr(Encrypt(cl_intto0str(cl_MultKey, 5), StartKey, MultKey, AddKey)) + cl_chartobytestr(Encrypt(cl_intto0str(cl_AddKey, 5), StartKey, MultKey, AddKey)) + cl_chartobytestr(Encrypt(S, cl_StartKey, cl_MultKey, cl_AddKey));
end;

function Encrypt(const InString: string; StartKey, MultKey, AddKey: Int64): string;
var
  i: byte;
begin
  Result := '';
  for i := 1 to length(InString) do begin
Result := Result + char(byte(InString) xor (StartKey shr 8));
StartKey := (byte(Result) + StartKey) * MultKey + AddKey;
  end;
end;
function cl_decrypt(S: string): string;
var
  cl_StartKey, cl_MultKey, cl_AddKey: Longint;
begin
  cl_StartKey := strtoint(Decrypt(cl_bytetocharstr(copy(S, 1, 9)), StartKey, MultKey, AddKey));
  cl_MultKey := strtoint(Decrypt(cl_bytetocharstr(copy(S, 10, 15)), StartKey, MultKey, AddKey));
  cl_AddKey := strtoint(Decrypt(cl_bytetocharstr(copy(S, 25, 15)), StartKey, MultKey, AddKey));
  Result := Decrypt(cl_bytetocharstr(copy(S, 40, length(S) - 39)), cl_StartKey, cl_MultKey, cl_AddKey);
end;
function Time_Encrypt(S: string; Time: Double): string; // 加密
var
  years, months, days, hours, mins, secs, msec: word;
  cl_StartKey, cl_MultKey, cl_AddKey: Longint;
begin
  years := 2003;
  months := 4;
  days := 18;
  decodetime(Time, hours, mins, secs, msec);
  cl_StartKey := msec;
  if cl_StartKey < 256 then cl_StartKey := cl_StartKey + 256;
  cl_MultKey := ((years - 1900) * 12 + months) * 30 + days + cl_StartKey * 10 + cl_StartKey;
  cl_AddKey := (23 * hours + mins) * 60 + secs + cl_StartKey * 10 + cl_StartKey;
  Result := cl_chartobytestr(Encrypt(cl_intto0str(cl_StartKey, 3), StartKey, MultKey, AddKey)) + cl_chartobytestr(Encrypt(cl_intto0str(cl_MultKey, 5), StartKey, MultKey, AddKey)) + cl_chartobytestr(Encrypt(cl_intto0str(cl_AddKey, 5), StartKey, MultKey, AddKey)) + cl_chartobytestr(Encrypt(S, cl_StartKey, cl_MultKey, cl_AddKey));
end;
function GetClientRegCode(Str: string): string;
var
  S: string;
  K, i, len: integer;
begin
  if length(Str) < 4 then
exit;
  S := Time_Encrypt(Str, 0.9234987);
  len := length(S);
  if len > 0 then begin
K := strtoint(S[length(S)]);
Result := '';
for i := 1 to len - 1 do
   Result := Result + inttostr((strtoint(S) + K) mod 10);
S := Result; Result := '';
for i := 1 to 4 do
   Result := Result + copy(S, len - i * 5, 5);
Result := Result + copy(S, len - 25, 5);
  end;
end;
function GetCPUIDStr: string;
var
  CPUID: TCPUID;
  i: integer;
  tmpstr: string;
begin
  Result := 'FFFFFFFFFFFFFFFF';
  tmpstr := '';
  for i := Low(CPUID) to High(CPUID) do
CPUID := -1;
  if IsCPUID_Available then begin
CPUID := GetCPUID;
for i := 1 to 4 do
   tmpstr := tmpstr + IntToHex((CPUID and $FFFF), 4);
  end;
  Result := tmpstr;
end;
function GetCPUVendor: TVendor; assembler; register;
asm
  PUSH EBX {Save affected register}
  PUSH EDI
  MOV    EDI,EAX {@Result (TVendor)}
  MOV    EAX,0
  DW    $A20F {CPUID Command}
  MOV    EAX,EBX
  XCHG EBX,ECX    {save ECX result}
  MOV ECX,4
@1:
  STOSB
  SHR    EAX,8
  LOOP @1
  MOV    EAX,EDX
  MOV ECX,4
@2:
  STOSB
  SHR    EAX,8
  LOOP @2
  MOV    EAX,EBX
  MOV ECX,4
@3:
  STOSB
  SHR    EAX,8
  LOOP @3
  POP    EDI {Restore registers}
  POP    EBX
end;

function GetCPUID: TCPUID; assembler; register;
asm
  PUSH EBX       {Save affected register}
  PUSH EDI
  MOV    EDI,EAX    {@Resukt}
  MOV    EAX,1
  DW    $A20F    {CPUID Command}
  STOSD       {CPUID[1]}
  MOV    EAX,EBX
  STOSD             {CPUID[2]}
  MOV    EAX,ECX
  STOSD             {CPUID[3]}
  MOV    EAX,EDX
  STOSD             {CPUID[4]}
  POP    EDI {Restore registers}
  POP    EBX
end;

function IsCPUID_Available: Boolean; register;
asm
PUSHFD {direct access to flags no possible, only via stack}
  POP    EAX {flags to EAX}
  MOV    EDX,EAX {save current flags}
  XOR    EAX,ID_BIT {not ID bit}
  PUSH EAX {onto stack}
  POPFD {from stack to flags, with not ID bit}
  PUSHFD {back to stack}
  POP    EAX {get back to EAX}
  XOR    EAX,EDX {check if ID bit affected}
  JZ    @exit {no, CPUID not availavle}
  MOV    AL,True {Result=True}
@exit:
end;

function GetTempDirectory: string;
var
  TempDir: array[0..255] of char;
begin
  GetTempPath(255, @TempDir);
  Result := TempDir;
end;
function CompressMDB(SouceFile, DestFile: string; Ver: string): Boolean;
var
  DAO: OLEVariant;
begin
  Result := False;
  if FileExists(SouceFile) then begin
if FileExists(DestFile) then DeleteFile(Pchar(DestFile));
try
   if Ver = '97' then
      DAO := CreateOleObject('DAO.DBEngine.35') // Access97
   else
      DAO := CreateOleObject('DAO.DBEngine.36'); // Access2000
   DAO.CompactDatabase(SouceFile, DestFile);
   Result := True;
except
end;
  end;
end;
function CompressDataBase(SouceFile: string): Boolean;
var
  Str: string;
begin
  Result := False;
  try
Str := GetTempDirectory + '~Temp.dat';
if SysUtils.FileExists(Str) then SysUtils.DeleteFile(Str);
if CompressMDB(SouceFile, Str, '2000') then {// 压缩成功} begin
   SysUtils.DeleteFile(SouceFile);
   CopyFile(Pchar(Str), Pchar(SouceFile), False);
   Result := True;
   SysUtils.DeleteFile(Str);
end;
  except
  end;
end;
end.

//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田田︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                　╬
//╬　　/■\/■\　　                ╬
//╬　　 <|　||　有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档

ybamei · 发表于 2010-10-22 23:18:35

Delphi的源码吧。看着熟悉。。。。！

PYbaby0393 · 发表于 2010-10-22 23:44:23

是DP的源码貌似是打开摄像头用的？

suchunping · 发表于 2010-10-23 06:45:18

楼主发这个的用意是什么呢要想利用还是

thanks9393 · 发表于 2010-10-28 10:15:36

StartKey = 897; {Start default key}
  MultKey = 58665; {Mult default key}
  AddKey = 28584; {Add default key}

这几个数是一个关键,如果这些数有变化,新会产生新的注册码.

function GetClientRegCode(Str: string): string;//这应该是计算注册码的地方  STR应该是机器码
var
  S: string;
  K, i, len: integer;
begin
  if length(Str) < 4 then
exit;
  S := Time_Encrypt(Str, 0.9234987);
  len := length(S);
  if len > 0 then begin
K := strtoint(S[length(S)]);
Result := '';
for i := 1 to len - 1 do
   Result := Result + inttostr((strtoint(S) + K) mod 10);
S := Result; Result := '';
for i := 1 to 4 do
   Result := Result + copy(S, len - i * 5, 5);
Result := Result + copy(S, len - 25, 5);
//  result就是最终根据指定字串计算出的注册码.
  end;
end;

账号		自动登录	找回密码
密码			注册

在线客服

工作时间

热线电话

站长

[讨论] 哪位高手看一下这个代码

评分