ustring.pas

用delphi开发的资料室图书借阅管理系统

unit Ustring;

interface
      Uses SysUtils,ADODB,DB,windows,Forms,ksskinstdcontrol,Dialogs,Winsock;
      function Getsum(e1:extended;f1:string):boolean;
      function ifright(a1:integer;b1,space:string):boolean;
      function Getsub(e1:integer;f1:string):extended;
      function Getsubstr(e1:integer;f1,space:string):string;
      Function RegulateStr(aString:String;Sepchar:String):String;

      Function Get_NodeID(strText:string):string;
      Function Get_nodeName(strnodeText:string):string;

      procedure forwenda(Q1:TADOQuery;Dset11:TADODataset;examid1:string;lsid1:string;ifmany:integer);
        //为答案表中的问答题的小问分配满分
      ////procedure decompression;
       procedure RunDosInMemo(DosApp:String);

       procedure Exp_Treeview(TV:TSeSkinSTreeView;SaveDia:TSaveDialog;file_Name:string);


      function GetIdeSerialNumber : pchar;
        function Encrypt(s0: String): String;
     procedure ReplaceChar(CH, CHR: char; var Str: string);

      function ShowHostName:string;
      function  Encrypt0(s0: String): String;
      function DenCrypt0(s1: String): String;
   type
    PTreeNodeInfo=^TTreeNodeInfo;
    TTreeNodeInfo= class
   private
  public
     Node_ID,Node_Name:string;
end;


implementation

   procedure ReplaceChar(CH, CHR: char; var Str: string);
begin
while pos(CH, Str) > 0 do
  begin
    Str[pos(CH, Str)] := CHR;
  end;
end;






procedure forwenda(Q1:TADOQuery;Dset11:TADODataset;examid1:string;lsid1:string;ifmany:integer);
var ifhas,m:integer;
      begin
        ifhas:=0;
      if ifmany=2 then
      begin
     Q1.Close;
     Q1.SQL.Clear;
     Q1.SQL.Text:='select count(*) from bigquestionstruct where epsid=(select epsid from exam where exid='
     +examid1+')'+' and bqqtid='+quotedstr('06');
     Q1.Open;       //判断是否有问答题
         if Q1.RecordCount>0 then
         begin
         ifhas:=1;
         end
         else
         begin
           ifhas:=2;
         end;
      end;

      if (ifhas=1) or (ifmany=3) then
      begin
           DSet11.Close;
           DSet11.CommandText:='';
           Dset11.CommandText:='select exampaperanswer.sqno,exampaperanswer.qno,exampaperanswer.fullscore,tinyquestionstruct.score_cb'+#13+
       'from exampaperquestion,exampaperanswer,bigquestionstruct,tinyquestionstruct '+#13+
       'where exampaperquestion.epid=exampaperanswer.epid and exampaperquestion.bqno=exampaperanswer.bqno '+#13+
       'and exampaperquestion.sqno=exampaperanswer.sqno and exampaperanswer.exid='+examid1+' and exampaperanswer.lsid='+quotedstr(lsid1)+#13+
       'and bigquestionstruct.bqsid=tinyquestionstruct.bqsid and bigquestionstruct.epsid=(select epsid from exam where exid='+examid1+')'+#13+
       'and exampaperquestion.tqsid=tinyquestionstruct.tqsid and bigquestionstruct.bqqtid='+quotedstr('06')+' order by 1';
          Dset11.Open;
        for m:=0 to Dset11.RecordCount-1 do
         begin
            Dset11.Edit;
            Dset11.FieldByName('fullscore').AsFloat:=
            Getsub(Dset11.fieldByname('qno').AsInteger,trim(Dset11.fieldByname('score_cb').AsString));
            Dset11.Post;
            Dset11.Next;
         end;


      end;

      end;

function ifright(a1:integer;b1,space:string):boolean;
var
      loc,last1:integer;
      m,n,k:integer;
      gg: Array of string;
 begin
   if b1<>'' then
   begin //---------------------------------------------------------------
      loc:=pos(space,b1);
       last1:=lastdelimiter('+',b1);
      if (loc=length(b1)) or (last1=length(b1)) then
      begin
      result:=false;   //表明以'+'结尾
      end
      else
      begin   //=======================================
      if loc=0 then
      begin //*******************************************************
         if a1=1 then
         result:=true
         else
         result:=false;
      end; //***************************************************

      if loc=1 then
      begin  //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      result:=false;
      end;  //%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

       if loc>1 then
      begin  //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
       k:=0;
       setlength(gg,length(b1));
        for m:=0 to length(b1)-1 do
        begin
        gg[m]:=copy(b1,m+1,1);
        end;

        for n:=0 to length(b1)-1 do
        begin
        if gg[n]=space then
        k:=k+1;                 //  得到'+' 号的个数
        end;

       if k+1=a1 then
        result:=true
       else
       result:=false;
      end;  //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
     end;//=============================================================
   end;  //----------------------------------------------------------------

 end;

function Getsum(e1:extended;f1:string):boolean;
var a,b,len:integer;
  stra,strb:string;
  gg: Array of string;
  m,n:integer;
  tot:extended;
begin
    
    tot:=0;

   stra:=f1;
   strb:=f1;
   len:=length(f1);
    setlength(gg,len);
    for a:=0 to len-1 do
    begin
     gg[a]:=copy(stra,a+1,1);
    end;

   for b:=0 to len-1 do
   begin
     if gg[b]='+' then
     begin
     m:=pos('+',stra);
        if m>0 then
        begin
         tot:=tot+strtofloat(copy(trim(stra),1,m-1));
         delete(stra,1,m);
         end;

      end;
   end;

   n:=lastDelimiter('+',strb);
   tot:=tot+strtofloat(copy(trim(strb),n+1,length(strb)-n));
    if tot<>e1 then
     result:=false
     else
     result:=true;

 end;

function Getsub(e1:integer;f1:string):extended;
var a,b:integer;
   stra,strb:string;
   gg: Array of string;
   m,n:integer;
   c,k,i,j:integer;
   loc:integer;

begin
   if f1<>'' then
   begin       //******************************************************************

    loc:=pos('+',f1);
    if loc=0 then
    begin
    result:=strtofloat(f1);
    end
    else
    begin // -----------------------------------

         if loc>1 then
      begin  //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
       k:=0;
       setlength(gg,length(f1));
        for i:=0 to length(f1)-1 do
        begin
        gg[i]:=copy(f1,i+1,1);
        end;

        for j:=0 to length(f1)-1 do
        begin
        if gg[j]='+' then
        k:=k+1;                 //  得到'+' 号的个数
        end;

      end;  //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$4

     if k+1=e1 then
     begin
     result:=strtofloat(copy(trim(f1),lastDelimiter('+',f1)+1,length(f1)-lastDelimiter('+',f1)));
     end
     else
     begin    //@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@222

    n:=0;
    c:=0;
   stra:=f1;
   strb:=f1;
    setlength(gg,length(f1));
    for a:=0 to length(f1)-1 do
    begin
     gg[a]:=copy(stra,a+1,1);
    end;

   for b:=0 to length(f1)-1 do
   begin
     if gg[b]='+' then
     begin
     m:=pos('+',stra);
        if m>0 then
             begin
             c:=c+1;
                 if c=e1 then
                    begin
                    result:=strtofloat(copy(trim(stra),1,m-1));
                    end;
                   delete(stra,1,m);
             end;
      end;
   end;
    end;//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@22

 end;//----------------------------------------------------------
 end;  //*******************************************************************************
 end;
{　 var
  　　i,Num:Integer;
  　　Flag:Boolean;
  　　MyStr,TempStr:String; }
 Function RegulateStr(aString:String;Sepchar:String):String;
     var i,num:integer;
     flag:Boolean;
     Mystr,TempStr:string;
    begin
   Flag:=False;//进行标志,去除多余的分割符
   Num:=Length(aString);//计算aString串的长度
    for i:=1 to Num do
   begin
   TempStr:=Copy(aString,i,1);//取aString串中的一字符
  if TempStr <> SepChar then
     begin
      MyStr:=MyStr+TempStr;
     Flag:=True;
        end
         else
          if(Flag=True)then
        begin
 Mystr:=Mystr+TempStr;
Flag:=False;
end;
end;
if  MyStr[Length(MyStr)] <> SepChar then
MyStr:=MyStr+SepChar;
Result:=MyStr;
end;


function Getsubstr(e1:integer;f1,space:string):string;
     var a,b:integer;
  stra,strb:string;
  gg: Array of string;
  m:integer;
  c,k,i,j:integer;

   loc:integer;
 begin
     if f1<>'' then
     begin       //******************************************************************

    loc:=pos(space,f1);
    if loc=0 then
    begin
    result:=f1;
    end
    else
    begin // -----------------------------------

         if loc>1 then
      begin  //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
       k:=0;
       setlength(gg,length(f1));
        for i:=0 to length(f1)-1 do
        begin
        gg[i]:=copy(f1,i+1,1);
        end;

        for j:=0 to length(f1)-1 do
        begin
        if gg[j]=space then
        k:=k+1;                 //  得到'+' 号的个数
        end;

      end;  //$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$4

     if k+1=e1 then
     begin
     result:=copy(trim(f1),lastDelimiter(space,f1)+1,length(f1)-lastDelimiter(space,f1))
     //strtofloat(copy(trim(f1),lastDelimiter('+',f1)+1,length(f1)-lastDelimiter('+',f1)));
     end
     else
     begin    //@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@222


    c:=0;
   stra:=f1;
   strb:=f1;
    setlength(gg,length(f1));
    for a:=0 to length(f1)-1 do
    begin
     gg[a]:=copy(stra,a+1,1);
    end;

   for b:=0 to length(f1)-1 do
   begin
     if gg[b]=space then
     begin
     m:=pos(space,stra);
        if m>0 then
             begin
             c:=c+1;
                 if c=e1 then
                    begin
                    result:=copy(trim(stra),1,m-1);
                    end;
                   delete(stra,1,m);
             end;
      end;
   end;
    end;//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@22

 end;//----------------------------------------------------------

 end;  //*******************************************************************************


 end;



 Function Get_NodeID(strText:string):string;
      var ps1:integer;
    begin
       ps1:=pos(']',strText);
       result:=trim(copy(strtext,2,ps1-2));
    end;
 //----------------------------------------------------------------------------------------------------
 procedure RunDosInMemo(DosApp:String);  //调用WinRAR命令行进行解压缩
const
   ReadBuffer = 2400;
var
Security            : TSecurityAttributes;                //windows
 ReadPipe,WritePipe  : THandle;
 start               : TStartUpInfo;
 ProcessInfo         : TProcessInformation;
 Buffer              : Pchar;             //system
 BytesRead           : DWord;
 Apprunning          : DWord;
begin
 With Security do begin
  nlength              := SizeOf(TSecurityAttributes);
  binherithandle       := true;
  lpsecuritydescriptor := nil;
 end;
 if Createpipe (ReadPipe, WritePipe,
                @Security, 0) then begin
  Buffer  := AllocMem(ReadBuffer + 1);
  FillChar(Start,Sizeof(Start),#0);
  start.cb          := SizeOf(start);
  start.hStdOutput  := WritePipe;
  start.hStdInput   := ReadPipe;
  start.dwFlags     := STARTF_USESTDHANDLES +
                       STARTF_USESHOWWINDOW;
  start.wShowWindow := SW_hide;

  if CreateProcess(nil,
         PChar(DosApp),
         @Security,
         @Security,
         true,
         NORMAL_PRIORITY_CLASS,
         nil,
         nil,
         start,
         ProcessInfo)
  then
  begin
   repeat
    Apprunning := WaitForSingleObject
                 (ProcessInfo.hProcess,100);
    Application.ProcessMessages;
   until (Apprunning <> WAIT_TIMEOUT);
    Repeat
      BytesRead := 0;
      Buffer[BytesRead]:= #0;
      OemToAnsi(Buffer,Buffer);

    until (BytesRead < ReadBuffer);
 end;