global.pas

自己做的用delphi开发的学生成绩管理系统。

unit global;

interface
uses IniFiles,SysUtils,Controls,Classes,windows,StrUtils,activex,nb30;

procedure WriteParaItem(AFile:pchar;ASection:pchar;AIdentity:pchar;AValue:pchar);stdcall;//写入ini文件指定项
function ReadParaItem(AFile:pchar;ASection:pchar;AIdentity:pchar;ADefault:pchar;pResult:pchar;len:integer):integer;stdcall;//读取ini文件中项内容

function EncodeStringA(Password:pchar;pResult:pChar;len:integer):integer;stdcall;//加密
procedure DecodeStringA(Code:pchar;pResult:pchar;len:integer);stdcall;//解密
function GetDaysOfMonth(year,month:integer):integer;stdcall;//取月份最大天数
function GetYear(Date: TDate): Integer;stdcall;//取年份
function GetMonth(Date: TDate): Integer;stdcall;//取月
function GetDay(Date: TDate): Integer;stdcall;//取日
function GetHour(Time: TTime): Integer;stdcall;//取时
function GetMinute(Time: TTime): Integer;stdcall;//取分
function GetSecond(Time: TTime): Integer;stdcall;//取秒
function GetMSecond(Time: TTime): Integer;stdcall;//取毫秒
procedure GetPy(HZ:pchar;pResult:pchar;len:integer);stdcall;//取字符串的每个汉字拼音第一个字母组成的字母串
function MatchSearchCode(SearchCode:pchar;StringList:pchar):integer;stdcall;//返回检索码在字符串数组中的对应位置
procedure GetDiskId(pResult:pchar;len:integer);stdcall;//获取硬盘型号标识与硬盘ID
function GetIdeDiskId : String;//获取硬盘ID
procedure GetNetCardAddress(pResult:pchar;len:integer);stdcall;//获取网卡地址
procedure GetStructStr(Str,Seperator,pResult:pchar;index:integer);stdcall;//获取用分隔符分隔的字符串索引为index的字符串
function GetSepCount(Str,Seperator:pchar):integer;stdcall;//取字符串中子串Seperator的个数。
function GetGUID:string;//获取一个唯一标识

implementation

procedure WriteParaItem(AFile:pchar;ASection:pchar;AIdentity:pchar;AValue:pchar);
var
  IniFile:TIniFile;
begin
   IniFile:=TIniFile.Create(AFile);
   IniFile.WriteString(ASection,AIdentity,AValue);
   IniFile.free;
end;

function ReadParaItem(AFile:pchar;ASection:pchar;AIdentity:pchar;ADefault:pchar;pResult:pchar;len:integer):integer;//读取ini文件中项内容
var
  IniFile:TIniFile;
  s:string;
begin
    result:=0;
    if not assigned(pResult) then
      exit;
   IniFile:=TIniFile.Create(AFile);
   s:=inifile.ReadString(ASection,AIdentity,ADefault);
   strplcopy(pResult,s,len-1);
   pResult[len-1]:=#0;
   result:=length(s)+1;
   IniFile.free;
end;


function EncodeStringA(Password:pchar;pResult:pChar;len:integer):integer;
//将要加密的Password长度为n,加密后的字符串长度为Length,偏移量为Segment
//Length计算方法:若100*n<2000,Length=2000,否则Length=100*n
//加密方法:生成Length个可显示随机字符(ASCII从32到127),
//然后根据第3个随机字符的ASCII码值计算偏移量(把每一位相加,如56,则偏移为5+6=11)
//然后把Password的每个字符减１后填入随机字符串,填入位置为84*i-Segment
//把Password的长度信息填入Segment+3位置,填入值为ASCII为32+n的字符
var
  Length1,i,i1,i2,i3,Segment:integer;
  RandChar:string;
  s:string;
  sPassword:string;
begin
  result:=0;
  if not assigned(pResult) then
    exit;
  randomize;
  s:='';
  sPassword:=Password;
  if length(sPassword)<=0 then
    exit;
  for i:=1 to length(sPassword) do
  begin
    if (ord(sPassword[i])>127) or (ord(sPassword[i])<32) then
      exit;
  end;
  Length1:= Length(sPassword) * 100;
  if Length1 < 2000 Then
      Length1:= 2000;

  for i:=0 to Length1 do
  begin
    RandChar:=chr(Random(95)+32);
    s:=s+RandChar;
  end;
  Segment:=Ord(s[3]);
  i1:=Segment div 100;
  Segment:=Segment-i1*100;
  i2:=Segment div 10;
  i3:=Segment-i2*10;
  Segment:=i1 + i2 + i3;

  for i:=1 to length(spassword) do
  begin
    s[84*i-Segment]:=chr(ord(sPassword[i])-1);
  end;
  s[Segment+3]:=Chr(Length(spassword)+32);
  strplcopy(pResult,s,len-1);
  Result:=length(s)+1;
end;

procedure DecodeStringA(Code:pchar;pResult:pchar;len:integer);//解密
//第3个字符的ASCII码值计算偏移量Segment(把每一位相加,如56,则偏移为5+6=11)
//密码串长度信息在Segment+3位置,字符ASCII值减去32
//密码存放位置为84*i-Segment
var i,Length1,i1,i2,i3,Segment:integer;
    s,t:string;
begin
  if not assigned(pResult) then
    exit;
  s:='';
  s:=Code;
  s:=trim(s);
  if length(s)<2000 then
    exit;
  for i:=1 to length(s) do
  begin
    if (ord(s[i])>127) or (ord(s[i])<32) then
      exit;
  end;
  Segment:=ord(s[3]);

  i1:=segment div 100;
  segment:=segment-i1*100;
  i2:=segment div 10;
  i3:=segment-i2*10;
  segment:=i1+i2+i3;
  Length1:=ord(s[segment+3])-32;
  t:='';
  for i:=1 to length1 do
    t:=t+chr(ord(s[84*i-Segment])+1);
  strplcopy(pResult,t,len-1);
  pResult[len-1]:=#0;
end;

//取年
function GetYear(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := y;
end;

//取月
function GetMonth(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := m;
end;

//取日
function GetDay(Date: TDate): Integer;
var
  y, m, d: WORD;
begin
  DecodeDate(Date, y, m, d);
  Result := d;
end;

//取时
function GetHour(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := h;
end;

//取分
function GetMinute(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := m;
end;

//取秒
function GetSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := s;
end;

//取毫秒
function GetMSecond(Time: TTime): Integer;
var
  h, m, s, ms: WORD;
begin
  DecodeTime(Time, h, m, s, ms);
  Result := ms;
end;

//取月份最大天数
function GetDaysOfMonth(year,month:integer):integer;
begin
  case month of
    1:result:=31;
    2:if isleapyear(year) then
        result:=29
      else
        result:=28;
    3:result:=31;
    4:result:=30;
    5:result:=31;
    6:result:=30;
    7:result:=31;
    8:result:=31;
    9:result:=30;
    10:result:=31;
    11:result:=30;
    12:result:=31;
    else
      result:=31;
  end;
end;


//取字符串的每个汉字拼音第一个字母组成的字母串
procedure GetPy(HZ:pchar;pResult:pchar;len:integer);
var i:integer;
    t:string;
    strTemp:string;
    strInput:string;
  //函数入口为汉字，返回值为该汉字拼音的第一个字母
  Function getHzPy(hzStr:string):string;
  var
    myHzm:word;
  //辅助函数,取一个字ASCII值
    function Asc(s:string):Word;
    var
      i:array[0..1] of byte;
    begin
      if ord(s[1])<128 then
      begin
        result:=ord(s[1]);
        exit;
      end;
      i[1]:=ord(s[1]);
      i[0]:=ord(s[2]);
      copymemory(@result,@i,2);
    end;
  begin
    if strlen(pchar(hzStr))>1 then
      myHzm:=Asc(hzStr)
    else
      myHzm:=ord(hzStr[1]);
    if (myHzm>=0) and (myHzm<256) then
    begin
      result:=hzStr;//字母
      exit;
    end;
    if (myHzm>=$B0A1) and (myHzm<=$B0C4) then
      result:='A'
    else if (myHzm>=$B0C5) and (myHzm<=$B2C0) then
      result:='B'
    else if (myHzm>=$B2C1) and (myHzm<=$B4ED) then
      result:='C'
    else if (myHzm>=$B4EE) and (myHzm<=$B6E9) then
      result:='D'
    else if (myHzm>=$B6EA) and (myHzm<=$B7A1) then
      result:='E'
    else if (myHzm>=$B7A2) and (myHzm<=$B8C0) then
      result:='F'
    else if (myHzm>=$B8C1) and (myHzm<=$B9FD) then
      result:='G'
    else if (myHzm>=$B9FE) and (myHzm<=$BBF6) then
      result:='H'
    else if (myHzm>=$BBF7) and (myHzm<=$BFA5) then
      result:='J'
    else if (myHzm>=$BFA6) and (myHzm<=$C0AB) then
      result:='K'
    else if (myHzm>=$C0AC) and (myHzm<=$C2E7) then
      result:='L'
    else if (myHzm>=$C2E8) and (myHzm<=$C4C2) then
      result:='M'
    else if (myHzm>=$C4C3) and (myHzm<=$C5B5) then
      result:='N'
    else if (myHzm>=$C5B6) and (myHzm<=$C5BD) then
      result:='O'
    else if (myHzm>=$C5BE) and (myHzm<=$C6D9) then
      result:='P'
    else if (myHzm>=$C6DA) and (myHzm<=$C8BA) then
      result:='Q'
    else if (myHzm>=$C8BB) and (myHzm<=$C8F5) then
      result:='R'
    else if (myHzm>=$C8F6) and (myHzm<=$CBF9) then
      result:='S'
    else if (myHzm>=$CBFA) and (myHzm<=$CDD9) then
      result:='T'
    else if (myHzm>=$CDDA) and (myHzm<=$CEF3) then
      result:='W'
    else if (myHzm>=$CEF4) and (myHzm<=$D188) then
      result:='X'
    else if (myHzm>=$D1B9) and (myHzm<=$D4D0) then
      result:='Y'
    else if (myHzm>=$D4D1) and (myHzm<=$D7F9) then
      result:='Z'
    else
    begin
      result:=rightstr(inttohex(myHzm,4),4);
    end;
  end;
begin
  i:=1;
  strTemp:='';
  strInput:=HZ;
  while i<=length(strInput) do
  begin
    if ord(strInput[i])<128 then
    begin
      strTemp:=strTemp+strInput[i];
      i:=i+1;
    end
    else
    begin
      t:=copy(strInput,i,2);
      strTemp:=strTemp+gethzpy(t);
      i:=i+2;
    end;
  end;
  if assigned(pResult) then
  begin
    strPlCopy(pResult,strTemp,Len-1);
    pResult[len-1]:=#0;
  end;
end;

//返回检索码在字符串数组中的对应位置
function MatchSearchCode(SearchCode:pchar;StringList:pchar):integer;
var i:integer;
    s:string;
    sSearchCode:string;
    sList:TstringList;
    ch:array[0..1024]of char;
begin
  if strlen(SearchCode)=0 then
  begin
    Result:=-1;
    exit;
  end;
  sSearchCode:=SearchCode;
  sList:=TStringList.Create;
  sList.Text:=StringList;
  sSearchCode:=trim(sSearchCode);
  Result:=-1;
  for i:=0 to sList.Count-1 do
  begin
    GetPy(pchar(sList.Strings[i]),@ch,sizeof(ch));
    s:=ch;
    s:=copy(s,1,strlen(pchar(sSearchcode)));
    if AnsiCompareText(s,sSearchCode)=0 then
    begin
      Result:=i;
      break;
    end;
  end;
  sList.Free;
end;