frmcustom.pas

发票管理系统其中包括： 1.租凭业发票 2.建筑业发票 3.固定资产发票 4.服务行业发票 5.无形资产发票

  i, j: Integer;
  temp, buf: array[0..3] of Byte;
begin
  for i := 0 to 7 do outData[i] := inData[i];
  initPermutation(outData);
  if desMode = dmEncry then
  begin
    for i := 0 to 15 do
    begin
      for j := 0 to 3 do temp[j] := outData[j]; 
      for j := 0 to 3 do outData[j] := outData[j + 4]; 
      encry(outData, subKey[i], buf); 
      for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j]; 
    end;

    for j := 0 to 3 do temp[j] := outData[j + 4];
    for j := 0 to 3 do outData[j + 4] := outData[j];
    for j := 0 to 3 do outData[j] := temp[j];
  end
  else if desMode = dmDecry then
  begin
    for i := 15 downto 0 do
    begin
      for j := 0 to 3 do temp[j] := outData[j];
      for j := 0 to 3 do outData[j] := outData[j + 4];
      encry(outData, subKey[i], buf);
      for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j];
    end;
    for j := 0 to 3 do temp[j] := outData[j + 4];
    for j := 0 to 3 do outData[j + 4] := outData[j];
    for j := 0 to 3 do outData[j] := temp[j];
  end;
  conversePermutation(outData);
end;



function EncryStr(Str, Key: string): string;
var
  StrByte, OutByte, KeyByte: array[0..7] of Byte;
  StrResult: string;
  I, J: Integer;
begin
  if (Length(Str) > 0) and (Ord(Str[Length(Str)]) = 0) then
    raise Exception.Create('Error: the last char is NULL char.');
  if Length(Key) < 8 then
    while Length(Key) < 8 do Key := Key + Chr(0);
  while Length(Str) mod 8 <> 0 do Str := Str + Chr(0);

  for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]);
  makeKey(keyByte, subKey);

  StrResult := '';

  for I := 0 to Length(Str) div 8 - 1 do
  begin
    for J := 0 to 7 do
      StrByte[J] := Ord(Str[I * 8 + J + 1]);
    desData(dmEncry, StrByte, OutByte);
    for J := 0 to 7 do
      StrResult := StrResult + Chr(OutByte[J]);
  end;

  Result := StrResult;
end;

function DecryStr(Str, Key: string): string;
var
  StrByte, OutByte, KeyByte: array[0..7] of Byte;
  StrResult: string;
  I, J: Integer;
begin
  if Length(Key) < 8 then
    while Length(Key) < 8 do Key := Key + Chr(0);

  for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]);
  makeKey(keyByte, subKey);

  StrResult := '';

  for I := 0 to Length(Str) div 8 - 1 do
  begin
    for J := 0 to 7 do StrByte[J] := Ord(Str[I * 8 + J + 1]);
    desData(dmDecry, StrByte, OutByte);
    for J := 0 to 7 do
      StrResult := StrResult + Chr(OutByte[J]);
  end;
  while (Length(StrResult) > 0) and
    (Ord(StrResult[Length(StrResult)]) = 0) do
    Delete(StrResult, Length(StrResult), 1);
  Result := StrResult;
end;



function EncryStrHex(Str, Key: string): string;
var
  StrResult, TempResult, Temp: string;
  I: Integer;
begin
  TempResult := EncryStr(Str, Key);
  StrResult := '';
  for I := 0 to Length(TempResult) - 1 do
  begin
    Temp := Format('%x', [Ord(TempResult[I + 1])]);
    if Length(Temp) = 1 then Temp := '0' + Temp;
    StrResult := StrResult + Temp;
  end;
  Result := StrResult;
end;

function DecryStrHex(StrHex, Key: string): string;
  function HexToInt(Hex: string): Integer;
  var
    I, Res: Integer;
    ch: Char;
  begin
    Res := 0;
    for I := 0 to Length(Hex) - 1 do
    begin
      ch := Hex[I + 1];
      if (ch >= '0') and (ch <= '9') then
        Res := Res * 16 + Ord(ch) - Ord('0')
      else if (ch >= 'A') and (ch <= 'F') then
        Res := Res * 16 + Ord(ch) - Ord('A') + 10
      else if (ch >= 'a') and (ch <= 'f') then
        Res := Res * 16 + Ord(ch) - Ord('a') + 10
      else raise Exception.Create('Error: not a Hex String');
    end;
    Result := Res;
  end;

var
  Str, Temp: string;
  I: Integer;
begin
  Str := '';
  for I := 0 to Length(StrHex) div 2 - 1 do
  begin
    Temp := Copy(StrHex, I * 2 + 1, 2);
    Str := Str + Chr(HexToInt(Temp));
  end;
  Result := DecryStr(Str, Key);
end;

procedure Anti_DeDe();
var
  DeDeHandle:THandle;
  i:integer;
begin
  DeDeHandle:=FindWindow(nil,chr($64)+chr($65)+chr($64)+chr($65));
  if DeDeHandle<>0 then
    begin
      For i:=1 to 4500000 do
        SendMessage(DeDeHandle,WM_CLOSE,0,0);
    end;
end;

procedure CheckParentProc;
var 
  Pn: TProcesseNtry32;
  sHandle: THandle;
  H, ExplProc, ParentProc: Hwnd;
  Found: Boolean;
  Buffer: array[0..1023] of Char;
  Path: string;
begin
  H := 0;
  ExplProc := 0;
  ParentProc := 0;
  
  SetString(Path,
            Buffer,
            GetWindowsDirectory(Buffer, Sizeof(Buffer) - 1));
  Path := UpperCase(Path) + '\EXPLORER.EXE'; 
  
  sHandle := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  Found := Process32First(sHandle, Pn); 
  while Found do 
  begin
    if Pn.szExeFile = ParamStr(0) then 
    begin
      ParentProc := Pn.th32ParentProcessID; 
      
      H := OpenProcess(PROCESS_ALL_ACCESS, True, Pn.th32ParentProcessID);
    end
    else if UpperCase(Pn.szExeFile) = Path then
      ExplProc := Pn.th32ProcessID;      
    Found := Process32Next(sHandle, Pn); 
  end;
  
  if ParentProc <> ExplProc then
  begin
    TerminateProcess(H, 0); 
    
  end;
end;


Function IsBPX(addr:Pointer):Boolean;stdcall;
var
  YInt,NInt:Integer;
begin
  asm
    mov esi,addr
    mov al,[esi]
    cmp al,$CC
    je @Yes
    jne @No
    @Yes:
      mov YInt,1
    @No:
      mov NInt,1
  end;
  if YInt=1 then
    Result:=True;
  if NInt=1 then
    Result:=False;
end;



Function IsDebug():Boolean;stdcall; 
var
  YInt,NInt:Integer;
begin
  asm
    mov eax,fs:[30h]
    movzx eax,byte ptr[eax+2h]
    or al,al
    jz @No
    jnz @Yes
    @No:
      mov NInt,1
    @Yes:
      Mov YInt,1
  end;
  if YInt=1 then
    Result:=True;
  if NInt=1 then
    Result:=False;
end;



Function DumpLoaded: Boolean;stdcall;  
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile := FindWindow(nil,'ProcDump32 (C) 1998, 1999, 2000 G-RoM, Lorian & Stone');
  if( hFile <> 0 ) then
  begin
    Result:= TRUE;
  end;
End;

Function RegLoaded: Boolean;stdcall;  
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile := FindWindow(nil,'Registry Monitor - Sysinternals: www.sysinternals.com');
  if( hFile <> 0 ) then
  begin
    Result:= TRUE;
  end;
End;

Function FileLoaded: Boolean;stdcall;  
var
  hFile: Thandle;
Begin
  Result:= false;
  hFile := FindWindow(nil,'File Monitor - Sysinternals: www.sysinternals.com');
  if( hFile <> 0 ) then
  begin
    Result:= TRUE;
  end;
End;

Function SoftIceXPLoaded:Boolean;stdcall;
var
  mark:Integer;
  YesInt,NoInt:Integer;
begin
  YesInt:=0;NoInt:=0;
  mark:=0;
  asm
    push offset @handler
    push dword ptr fs:[0]
    mov  dword ptr fs:[0],esp
    xor  eax,eax
    int 1
    inc  eax
    inc  eax
    pop  dword ptr fs:[0]
    add esp,4
    or   eax,eax
    jz   @found
    cmp mark, 0
    jnz   @found
    jmp  @Nofound
    @handler:
      mov ebx,[esp+0ch]
      add dword ptr [ebx+0b8h],02h
      mov ebx,[esp+4]
      cmp [ebx], 80000004h
      jz @Table
      inc mark
    @Table:
      xor eax,eax
     ret
    @found:
      mov YesInt,1
    @Nofound:
      mov NoInt,1
  end;
  if Yesint=1 then
    Result:=True;
  if NoInt=1 then
    Result:=False;
end;

end.