upublic.pas

工商银行限制了牡丹卡的网上交易功能.催着我们去各分行办领一张网上交易的通行证:口令卡 口令卡确实是一个好东东,但使用有点不方便.为此,我写了这个程序--你能将自己的口令保存为一个程序, 在

unit uPublic;

interface

uses
  Windows, Messages,
  SysUtils, Classes;


type
  TFileRec = record
    FuncName,
    AppName: string[128];
    Charline: string[10];
    Data: array[1..8,1..10] of String[3];
  end;

TFileRecError = class(Exception);


//这些没有用到:
//begin
  C1 = '!'..'/';
  C2 = ':'..'@';
  C3 = '['..'`';
  C4 = '{'..'~';

  lk = 'a'..'z';
  uk = 'A'..'Z';
  Num = '0'..'9';
//end;

  TCharType = (ctNum,ctDot,ctABC,ctEmpty);

function SaveToFile(const FileName: string; const dt: TFileRec; Add: Boolean = true): Boolean;

Function LoadFormFile(const FileName: string; var dt: TFileRec): Boolean;

Function CheckData(dt: TFileRec; var ErrStr: string): Boolean;

Function GetKeyByFunc(Code: string; Dt: TFileRec): string;

function GetFirstKeyWord(var pos: Integer;var Typ: TCharType; code: string):string;

Function GetKeyType(pos: integer; Code: string):TCharType;

function GetIndexByChar(const dt: TFileRec; const c: Char):integer;

Function GetKeyWord(dt: TFileRec; const c: Char; i: Integer ): string;


implementation

Function GetKeyWord(dt: TFileRec; const c: Char; i: Integer ): string;
var
  j: integer;
begin
  result := '';
  j := GetIndexByChar(dt,c);
  if j <> -1 then
  begin
    if (i >= low(dt.Data)) and (i <= high(dt.Data)) then
      result := dt.Data[i,j];
  end;
end;

Function CheckData(dt: TFileRec; var ErrStr: string): Boolean;
     Function CheckKey(const s: string): boolean;
     var
       i: integer;
     begin
       result := true;
       for i := 1 to 3 do
         if not (s[i] in ['0'..'9']) then
           result := false;
     end;
var
  i,j: integer;
  s: string[3];
begin
  result := Boolean(1);

  if Trim(dt.FuncName) = '' then
  begin
    result := false;
    ErrStr := '函数名称出现问题.';
    exit;
  end;

  dt.Charline := LowerCase(dt.Charline);
  for i := 1 to 10 do
    if not (dt.Charline[i] in ['a'..'z']) then
    begin
      result := false;
      ErrStr := '序列字母出现问题.';
      Break;
    end;
  if integer(result) > 0 then
  begin
    for i := Low(dt.data) to High(dt.data) do
      if Result then
        for j := Low(dt.data[i]) to high(dt.data[i]) do
        begin
          s := dt.data[i,j];
          if not CheckKey(s) then
          begin
            ErrStr := '解码字符出现问题.';
            result := false;
            Break;
          end;
        end;
  end;
end;

Function GetKeyByFunc(Code: string; Dt: TFileRec): string;
var
  len,pos: Integer;
  typ: TCharType;
  s: string;
  Turbo: boolean;
begin
  code := LowerCase(Code);
  pos := 1;
  len := length(code);
  Dt.Charline := LowerCase(dt.Charline);
  dt.FuncName := trim(LowerCase(dt.FuncName));
  Turbo := true;
  s := GetFirstKeyword(pos,typ,Code);
  case typ of
    ctNum,
    ctDot:
    begin
      result := '声明函数名称的字符是错误的.';
      exit;
    end;
    ctEmpty:
    begin
      result := '空白的代码.';
      exit;
    end;
    ctAbc: Turbo := SameText(s,Dt.FuncName);
  end;
  if not turbo then
  begin
    result := '没有找到匹配的函数名称.';
    Exit;
  end;
  s := GetFirstKeyword(pos,typ,Code);
  case typ of
    ctNum,
    ctABC:
    begin
      result := '发现多余的文本:' + s;
      exit;
    end;
    ctEmpty: result := '代码异常结束了.';
    ctDot: TurBo := s = '(';
  end;
  if not Turbo then
  begin
    result := '函数之后紧跟着的符号是:"(". ';
    exit;
  end;
  s := GetFirstKeyword(pos,typ,Code);
  if typ = ctAbc then
  begin
    while Length(s) < 4 do
    begin
      s := s + GetFirstKeyword(pos,typ,code);
      if (typ = ctdot) or (typ = CtEmpty) then
      begin
        result := '参数错误.';
        Turbo := false;
        Break;
      end;
    end;
  end
  else
    result := '参数错误.';

  if Turbo then
  begin
    if length(s) > 4 then
    begin
      result := '参数错误.';
    end
    else
    if not ((s[1] in ['a'..'z']) and (s[2] in ['0'..'9'])
       and (s[1] in ['a'..'z'])  and (s[2] in ['0'..'9']) ) then
       result := '错误的参数:' + s
    else
    begin
      if GetFirstKeyWord(pos,typ,code) <> ')' then
        result :=  '缺少括号 ")".'
      else
      begin
        result := GetKeyWord(dt,s[1],StrToInt(s[2]));
        s := GetKeyWord(dt,s[3],StrToInt(s[4]));

        if (result = '') or (s = '') then
        begin
          Result := '不匹配的参数.';
          exit;
        end
        else result := result + s;
      end;
    end;
  end;

end;

function GetFirstKeyWord(var pos: Integer;var typ: TCharType; code: string):string;
var
  len: integer;
begin
  len := length(code);
  result := '';
  while (pos <= len) and (code[pos] in [#0..#32]) do inc(pos);
  if pos > len then
  begin
    Typ := ctEmpty;
    exit;
  end;
  Typ := GetKeyType(pos,Code);
  if typ = ctABC then
  begin
    result := code[Pos];
    inc(pos);
    while (pos <= len) and (code[pos] in ['A'..'Z','a'..'z','0'..'9']) do
    begin
      result := result + code[pos];
      inc(pos);
    end;
  end
  else
  if Typ = ctnum then
  begin
    result := code[Pos];
    Inc(pos);
    while (pos <= len) and (code[pos] in ['0'..'9']) do
    begin
      result := result + code[pos];
      inc(pos);
    end;
  end
  else
  if typ = ctdot then
  begin
    result := code[pos];
    inc(pos);
  end;
end;

Function GetKeyType(pos: integer; Code: string):TCharType;
begin
  result := ctEmpty;
  if (pos > 0) and (pos <= length(code)) then
  begin
    if Code[pos] in ['a'..'z','A'..'Z'] then
      result := ctABC
    else
    if code[pos] in ['0'..'9'] then
       Result := ctNum
    else
    if (Code[pos] in ['!'..'/']) or
      (Code[pos] in [':'..'@']) or
      (Code[pos] in ['['..'`']) or
      (Code[pos] in ['{'..'~']) then
      result := ctdot;
  end;
end;

function GetIndexByChar(const dt: TFileRec; const c: Char):integer;
var
  i: integer;
begin
  result := -1;
  for i := 1 to 10 do
   if dt.Charline[i] = c then
   begin
     result := i;
     Break;
   end;
end;

Function LoadFormFile(const FileName: string; var dt: TFileRec): Boolean;
var
  Stream: TStream;
begin
  result := boolean(0);
  if fileExists(FileName) then
  begin
    Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
    try
      if Stream.Size >= sizeof(dt) then
      begin
        Stream.Position := Stream.size - sizeof(dt);
        stream.Read(dt,sizeof(dt));
        result := true;
      end;
    finally
      Stream.Free;
    end;
  end;
end;

function SaveToFile(const FileName: string; const dt: TFileRec; Add: Boolean = true): Boolean;
var
  Stream: TStream;
  res: TResourceStream;
begin
  result := boolean(0);
  Stream := TMemoryStream.Create;
  try

    res := TResourceStream.Create(HInstance,'ICBC','I_C_B_C');
    try
      TMemoryStream(Stream).LoadFromStream(res);
    finally res.Free; end;

    if add then
      Stream.Size := stream.Size + sizeof(dt);
    if Stream.Size >= sizeof(dt) then
    begin
      Stream.Position := Stream.size - sizeof(dt);
      stream.write(dt,sizeof(dt));
      TMemoryStream(Stream).SaveToFile(Filename);
      result := true;
    end;
  finally
    Stream.Free;
  end;
end;

end.