rich_sys.pas

一个地方税务征收管理系统

var
  i: integer;
begin
  for i := 1 to n do
    s := s + s1;
  Result := s;
end;

{------------------------------------------------------------------------------}

function InsertMidStr(s, s1: string; p, n: integer): string;
{------------------------------------------------------------------------------}
{ Inserts n copies of the string s1 at position p in s. }
var
  i, ls: integer;
  c: string;
begin
  c := LeftStr(s, p - 1);
  for i := 1 to n do
    c := c + s1;
  ls := Length(s);
  Result := c + RightStr(s, ls - p + 1);
end;

{------------------------------------------------------------------------------}

function ReplaceAllStr(s, s1, s2: string): string;
{------------------------------------------------------------------------------}
{ Replaces all occurences of s1 in s with s2. }
var
  i, j, ls, ls1: integer;
  c: string;
begin
  i := 1;
  ls := Length(s);
  ls1 := Length(s1);
  c := '';
  while (i <= ls) do
  begin
    if MatchStr(s, s1, i, j, ls, ls1) then
    begin
      c := c + s2;
      i := j;
    end
    else
    begin { no occurence ... }
      c := c + s[i];
      inc(i);
    end;
  end;
  Result := c;
end;

{------------------------------------------------------------------------------}

function ReplaceStr(s, s1, s2: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Replaces the nth occurence of s1 in s with s2. }
var
  i, ls, ls1: integer;
  left_s, right_s: string;
begin
  i := LeftPosStr(s, s1, n);
  if i = 0 then
    Result := s
  else
  begin
    if (i = 1) then
      left_s := ''
    else
      left_s := LeftStr(s, i - 1);
    ls := Length(s);
    ls1 := Length(s1);
    if (i - ls1 = ls) then
      right_s := ''
    else
      right_s := RightStr(s, ls - i - ls1);
    Result := left_s + s2 + right_s;
  end;
end;

{------------------------------------------------------------------------------}

function ConvToUpperStr(s: string; p, k: integer): string;
{------------------------------------------------------------------------------}
{ Converts lower case letters to upper case. }
var
  i, a, t, ls: integer;
  cs: string;
begin
  ls := Length(s);
  cs := Copy(s, 1, ls);
  t := -ASCII_LOWER_A + ASCII_UPPER_A;
  p := Bound(p, 1, ls);
  for i := p to k do
  begin
    a := ord(s[i]);
    if (a >= ASCII_LOWER_A) and (a <= ASCII_LOWER_Z) then
      cs[i] := chr(a + t)
    else
      cs[i] := chr(a);
  end;
  Result := cs;
end;

{------------------------------------------------------------------------------}

function ConvToLowerStr(s: string; p, k: integer): string;
{------------------------------------------------------------------------------}
{ Converts upper case letters to lower case. }
var
  i, a, t, ls: integer;
  cs: string;
begin
  ls := Length(s);
  cs := Copy(s, 1, ls);
  t := ASCII_LOWER_A - ASCII_UPPER_A;
  p := Bound(p, 1, ls);
  for i := p to k do
  begin
    a := ord(s[i]);
    if (a >= ASCII_UPPER_A) and (a <= ASCII_UPPER_Z) then
      cs[i] := chr(a + t)
    else
      cs[i] := chr(a);
  end;
  Result := cs;
end;

{------------------------------------------------------------------------------}

function CountStr(s, s1: string): integer;
{------------------------------------------------------------------------------}
{ Counts the number of occurences of string s1 in string s, starting at
  position p and continuing for the specified length. }
var
  i, j, k, ls, ls1: integer;
  c: string;
begin
  i := 1;
  ls := Length(s);
  ls1 := Length(s1);
  c := '';
  k := 0;
  while (i <= ls) do
  begin
    if MatchStr(s, s1, i, j, ls, ls1) then
    begin
      inc(k);
      i := j;
    end
    else
      inc(i);
  end;
  Result := k;
end;

{------------------------------------------------------------------------------}

function IIfStr(b: boolean; s, s1: string): string;
{------------------------------------------------------------------------------}
{ Returns s if b is true s1 otherwise }
begin
  if b then
    Result := s
  else
    Result := s1;
end;

{------------------------------------------------------------------------------}

function ValidChrStr(s, s1: string): boolean;
{------------------------------------------------------------------------------}
{ Returns true if all the characters of string s are in s1, false otherwise. }
var
  i, j, ls, ls1: integer;
  ok, found: boolean;
begin
  ls := Length(s);
  ls1 := Length(s1);
  ok := true;
  i := 1;
  while (i <= ls) and ok do
  begin
    found := false;
    j := 1;
    while (j <= ls1) and not found do
      if (s[i] = s1[j]) then
        found := true
      else
        inc(j);
    ok := found;
    inc(i);
  end;
  Result := ok;
end;

{------------------------------------------------------------------------------}

function ValidIntStr(s: string; a, b: integer; var i: integer): boolean;
{------------------------------------------------------------------------------}
{ Validates an integer. }
var
  code, t: integer;
begin
  Val(s, t, code);
  if (code = 0) and (t >= a) and (t <= b) then
  begin
    i := t;
    Result := True;
  end
  else
    Result := False;
end;

{------------------------------------------------------------------------------}

function ValidLenStr(s: string; a, b: integer): boolean;
{------------------------------------------------------------------------------}
{ Validates the length of a string. }
var
  ls: integer;
begin
  ls := Length(s);
  if (ls >= a) and (ls <= b) then
    Result := True
  else
    Result := False;
end;

{------------------------------------------------------------------------------}

function TokenStr(s, s1: string; n: integer): string;
{------------------------------------------------------------------------------}
{ Gets the nth token (string) in s whose tokens are separated by the delimeter
  string in s1. }
var
  i, j, ls: integer;
begin
  ls := Length(s);
  if (n < 1) or (ls = 0) then
    Result := ''
  else
  begin
    { Calculate 1st character position of the nth token. }
    if (n = 1) then
      i := 1
    else
      i := LeftPosStr(s, s1, n - 1) + Length(s1);
    if (i > ls) then
      Result := ''
    else
    begin
      { Calculate 1st character after nth token. }
      j := LeftPosStr(s, s1, n);
      if (j = 0) then j := ls + 1;
      Result := MidStr(s, i, j - i);
    end;
  end;
end;
{$R-}
{$Q-}
//encrypt strings

function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
  string;
var
  I: Byte;
begin
  Result := '';
  for I := 1 to Length(InString) do
  begin
    Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
    StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;
  end;
end;
{*******************************************************
 * Standard Decryption algorithm - Copied from Borland *
 *******************************************************}

function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer):
  string;
var
  I: Byte;
begin
  Result := '';
  for I := 1 to Length(InString) do
  begin
    Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));
    StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;
  end;
end;
{$R+}
{$Q+}

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 GetCPUVendor: TCPUVendor; 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 incno(str: string; Mstep: Integer): string;
var
  s1, s2: string;
begin
  if Length(str) <= 4 then
    Result := inttostr(strtoint(str) + Mstep)
  else
  begin
    s2 := copy(STR, length(str) - 3, 4);
    s2 := inttostr(strtoint(s2) + Mstep);
    case Length(s2) of
      1: s2 := '000' + s2;
      2: s2 := '00' + s2;
      3: s2 := '0' + s2;
    end;
    s1 := copy(str, 1, length(str) - 4);
    Result := s1 + S2;
  end;
end;
{ TCpuInfo }

function GetcpuID_Asstring: string;
var
  s: TCPUID;
  t: string;
  i: integer;
begin
  s := GetCPUID;
  t := '';
  for i := 1 to 4 do
  begin
    t := t + IntToStr(S[i]);
    Result := t;
  end;
end;

function TurnMoneyStr(fMoneyNumber: Double): string;
//*** 将数值转换成Money字符串 ***
var
  ChineseNumber: array[1..9, 0..3] of string[4];
  JiaoNumber, FenNumber: array[1..9] of string[4];
  i, WhereP, T, PT: integer;
  TempString, StrZheng: string;
  SString, DString: string;
begin
  SString := FloatToStr(fMoneyNumber);

  ChineseNumber[1, 0] := '壹';
  ChineseNumber[1, 1] := '壹拾';
  ChineseNumber[1, 2] := '壹佰';
  ChineseNumber[1, 3] := '壹仟';

  ChineseNumber[2, 0] := '贰';
  ChineseNumber[2, 1] := '贰拾';
  ChineseNumber[2, 2] := '贰佰';
  ChineseNumber[2, 3] := '贰仟';

  ChineseNumber[3, 0] := '叁';
  ChineseNumber[3, 1] := '叁拾';
  ChineseNumber[3, 2] := '叁佰';
  ChineseNumber[3, 3] := '叁仟';

  ChineseNumber[4, 0] := '肆';
  ChineseNumber[4, 1] := '肆拾';
  ChineseNumber[4, 2] := '肆佰';
  ChineseNumber[4, 3] := '肆仟';

  ChineseNumber[5, 0] := '伍';
  ChineseNumber[5, 1] := '伍拾';
  ChineseNumber[5, 2] := '伍佰';
  ChineseNumber[5, 3] := '伍仟';

  ChineseNumber[6, 0] := '陆';
  ChineseNumber[6, 1] := '陆拾';
  ChineseNumber[6, 2] := '陆佰';
  ChineseNumber[6, 3] := '陆仟';

  ChineseNumber[7, 0] := '柒';
  ChineseNumber[7, 1] := '柒拾';
  ChineseNumber[7, 2] := '柒佰';
  ChineseNumber[7, 3] := '柒仟';

  ChineseNumber[8, 0] := '捌';
  ChineseNumber[8, 1] := '捌拾';
  ChineseNumber[8, 2] := '捌佰';
  ChineseNumber[8, 3] := '捌仟';

  ChineseNumber[9, 0] := '玖';
  ChineseNumber[9, 1] := '玖拾';
  ChineseNumber[9, 2] := '玖佰';
  ChineseNumber[9, 3] := '玖仟';

  JiaoNumber[1] := '壹角';
  JiaoNumber[2] := '贰角';
  JiaoNumber[3] := '叁角';
  JiaoNumber[4] := '肆角';
  JiaoNumber[5] := '伍角';
  JiaoNumber[6] := '陆角';
  JiaoNumber[7] := '柒角';
  JiaoNumber[8] := '捌角';
  JiaoNumber[9] := '玖角';

  FenNumber[1] := '壹分';
  FenNumber[2] := '贰分';
  FenNumber[3] := '叁分';
  FenNumber[4] := '肆分';
  FenNumber[5] := '伍分';
  FenNumber[6] := '陆分';
  FenNumber[7] := '柒分';
  FenNumber[8] := '捌分';
  FenNumber[9] := '玖分';

  WhereP := 0;
  StrZheng := '圆';
  for i := 1 to Length(SString) do
    if SString[i] = '.' then WhereP := i;
  if WhereP = 0 then
  begin
    WhereP := Length(SString) + 1;
    StrZheng := '圆整';
  end;
  PT := 0; {表示前一个字符的值}
  TempString := '';
  if not ((WhereP = 1) or (WhereP = 2)) then
  begin
    for i := 1 to WhereP - 1 do
    begin
      if SString[WhereP - i] = '-' then
        TempString := '负' + TempString
      else