⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 shareunit.pas

📁 三层的通用架构
💻 PAS
📖 第 1 页 / 共 2 页
字号:
🔍
12 
  if IsWindow(RegisterHandle) then
    if GetRegisterInfo = 'Y' then
      Result := RegisterStrings[2]
    else
      Result := '';
end;

function ShowRegisterForm: Boolean;
var
  i, MessageResult: Integer;
begin
  Result := False;
  if not IsWindow(RegisterHandle) then
    Exit;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, 0, 0);
    if MessageResult <> -1 then
      Break;
  end;
  if MessageResult = 1 then
    Result := True;
end;

function SetRegisterInfo(User, Info: string): Boolean;
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  Result := False;
  if not IsWindow(RegisterHandle) then
    Exit;
  P.Bz := $FF;
  P.ValueSize := Length(User);
  if P.ValueSize > 0 then
    P.ValueBuf := @User[1]
  else
    P.ValueBuf := nil;
  P.PassSize := Length(Info);
  if P.PassSize > 0 then
    P.PassBuf := @Info[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, 100, Integer(@P));
    if MessageResult <> -1 then
      Break;
  end;
  if MessageResult = 1 then
    Result := True;
end;

function SetLanguage(PLanguage: Pointer): Boolean;
var
  i, MessageResult: Integer;
begin
  //PLanguage指向内存（不含逗号和省略号）：一个字节字符集，一个字节字体大小，字体名称＃0，字符串4＃0，字符串5＃0，......，字符串17＃0
  //如一个字符串：#134#9'宋体'#0'警告'#0'出现未知错误'＃0......'取消(&C)'#0
  Result := False;
  if not IsWindow(RegisterHandle) or not Assigned(PLanguage) then
    Exit;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, 1000, Integer(PLanguage));
    if MessageResult <> -1 then
      Break;
  end;
  if MessageResult = 1 then
    Result := True;
end;

function SetRegisterHint(PHint: Pointer): Boolean;
var
  i, MessageResult: Integer;
begin
  //PHint指向内存（不含逗号）:过期后输入框颜色转换成的字符串＃0，提示信息＃0，主页＃0，邮箱地址＃0
  //如一个字符串：'$0000FF'#0'请注册本软件'#0'http://www.server.com'#0'mailto:someone@server.com'#0
  Result := False;
  if not IsWindow(RegisterHandle) or not Assigned(PHint) then
    Exit;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, 10000, Integer(PHint));
    if MessageResult <> -1 then
      Break;
  end;
  if MessageResult = 1 then
    Result := True;
end;

procedure Compress(InBuf: Pointer; InBytes: Integer; var OutBuf: Pointer; var OutBytes: Integer; Password: string = '');
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  OutBuf := nil;
  OutBytes := 0;
  if not IsWindow(RegisterHandle) or not Assigned(InBuf) or (InBytes = 0) then
    Exit;
  P.Bz := 0;
  P.ValueSize := InBytes;
  P.ValueBuf := InBuf;
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      GetMem(OutBuf, P.ValueSize);
      OutBytes := P.ValueSize;
      CopyMemory(OutBuf, P.ValueBuf, P.ValueSize);
    except
      OutBuf := nil;
      OutBytes := 0;
    end;
end;

procedure Decompress(InBuf: Pointer; InBytes: Integer; var OutBuf: Pointer; var OutBytes: Integer; Password: string = ''; OutEstimate: Integer = 0);
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  OutBuf := nil;
  OutBytes := 0;
  if not IsWindow(RegisterHandle) or not Assigned(InBuf) or (InBytes = 0) then
    Exit;
  P.Bz := 1;
  P.ValueSize := InBytes;
  P.ValueBuf := InBuf;
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      GetMem(OutBuf, P.ValueSize);
      OutBytes := P.ValueSize;
      CopyMemory(OutBuf, P.ValueBuf, P.ValueSize);
    except
      OutBuf := nil;
      OutBytes := 0;
    end;
end;

function StringCompress(SourceString: string; Password: string = ''; HFlag: Boolean = True): string;
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  Result := '';
  if not IsWindow(RegisterHandle) or (SourceString = '') then
    Exit;
  if HFlag then
    P.Bz := 10
  else
    P.Bz := 20;
  P.ValueSize := Length(SourceString);
  P.ValueBuf := @SourceString[1];
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      SetLength(Result, P.ValueSize);
      CopyMemory(@Result[1], P.ValueBuf, P.ValueSize);
    except
      Result := '';
    end;
end;

function StringDecompress(SourceString: string; Password: string = ''; HFlag: Boolean = True): string;
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  Result := '';
  if not IsWindow(RegisterHandle) or (SourceString = '') then
    Exit;
  if HFlag then
    P.Bz := 11
  else
    P.Bz := 21;
  P.ValueSize := Length(SourceString);
  P.ValueBuf := @SourceString[1];
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      SetLength(Result, P.ValueSize);
      CopyMemory(@Result[1], P.ValueBuf, P.ValueSize);
    except
      Result := '';
    end;
end;

procedure Encrypt(InBuf: Pointer; InBytes: Integer; var OutBuf: Pointer; var OutBytes: Integer; Password: string = '');
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  OutBuf := nil;
  OutBytes := 0;
  if not IsWindow(RegisterHandle) or not Assigned(InBuf) or (InBytes = 0) then
    Exit;
  P.Bz := 100;
  P.ValueSize := InBytes;
  P.ValueBuf := InBuf;
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      GetMem(OutBuf, P.ValueSize);
      OutBytes := P.ValueSize;
      CopyMemory(OutBuf, P.ValueBuf, P.ValueSize);
    except
      OutBuf := nil;
      OutBytes := 0;
    end;
end;

procedure Decrypt(InBuf: Pointer; InBytes: Integer; var OutBuf: Pointer; var OutBytes: Integer; Password: string = ''; OutEstimate: Integer = 0);
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  OutBuf := nil;
  OutBytes := 0;
  if not IsWindow(RegisterHandle) or not Assigned(InBuf) or (InBytes = 0) then
    Exit;
  P.Bz := 101;
  P.ValueSize := InBytes;
  P.ValueBuf := InBuf;
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      GetMem(OutBuf, P.ValueSize);
      OutBytes := P.ValueSize;
      CopyMemory(OutBuf, P.ValueBuf, P.ValueSize);
    except
      OutBuf := nil;
      OutBytes := 0;
    end;
end;

function StringEncrypt(SourceString: string; Password: string = ''; HFlag: Boolean = True): string;
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  Result := '';
  if not IsWindow(RegisterHandle) or (SourceString = '') then
    Exit;
  if HFlag then
    P.Bz := 110
  else
    P.Bz := 120;
  P.ValueSize := Length(SourceString);
  P.ValueBuf := @SourceString[1];
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      SetLength(Result, P.ValueSize);
      CopyMemory(@Result[1], P.ValueBuf, P.ValueSize);
    except
      Result := '';
    end;
end;

function StringDecrypt(SourceString: string; Password: string = ''; HFlag: Boolean = True): string;
var
  P: TUserRecord;
  i, MessageResult: Integer;
begin
  Result := '';
  if not IsWindow(RegisterHandle) or (SourceString = '') then
    Exit;
  if HFlag then
    P.Bz := 111
  else
    P.Bz := 121;
  P.ValueSize := Length(SourceString);
  P.ValueBuf := @SourceString[1];
  P.PassSize := Length(Password);
  if P.PassSize > 0 then
    P.PassBuf := @Password[1]
  else
    P.PassBuf := nil;
  for i := 1 to 100 do
  begin
    MessageResult := SendMessage(RegisterHandle, WM_USER, High(Integer), Integer(@P));
    if MessageResult = 1 then
      Break;
  end;
  if MessageResult = 1 then
    try
      SetLength(Result, P.ValueSize);
      CopyMemory(@Result[1], P.ValueBuf, P.ValueSize);
    except
      Result := '';
    end;
end;

initialization
  GetRegisterHandle;
  Csh;
  CshComServer;

finalization
  IgnoreException := True;
  if Assigned(RegisterStrings) then
    RegisterStrings.Free;
  SystemParams.Free;
  SystemParams := nil;
  Connections.Free;
  Connections := nil;

end.
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -