wscores.pas

来自「这是一个正式的项目工程」· PAS 代码 · 共 869 行 · 第 1/2 页

Function  GetName(Str:String):String;
var
  iP,iCount:Integer;
begin
  Result:='';
  iP:=0;
  iCount:=0;
  iP:=Pos('[',Str);
  iCount:=iP-1;
  if iCount>=1 then
    Result:=Copy(Str,1,iCount);
  Result:=Trim(Result);
end;

Procedure UpdateSystemDB(qryPublic:TQuery;Flag,Status:String);
begin
  if Trim(Flag)<>'' then
  begin
    with qryPublic do
    begin
      Close;
      SQL.Clear;
      SQL.Add('Select * from  System Where Upper(Flag)=:Flag');
      ParamByName('Flag').AsString:=UpperCase(Flag);
      Prepare;
      try
        Open;
      except
        ExecSQL;
      end;
      if Not isEmpty then
      begin
        Close;
        SQL.Clear;
        SQL.Add('Update System Set Status=:Status Where Upper(Flag)=:Flag');
        ParamByName('Status').AsString:=Status;
        ParamByName('Flag').AsString:=UpperCase(Flag);
        Prepare;
        ExecSQL;
        Close;
      end
      else
      begin
        Close;
        SQL.Clear;
        SQL.Add('Insert Into System(Status,Flag) Values(:Status,:Flag)');
        ParamByName('Status').AsString:=Status;
        ParamByName('Flag').AsString:=UpperCase(Flag);
        Prepare;
        ExecSQL;
        Close;
      end;
    end;
  end;
end;

Function GetSystemDBStatus(qryPublic:TQuery;Flag:String):String;
begin
  Result:='';
  if Trim(Flag)<>'' then
  begin
    with qryPublic do
    begin
      Close;
      SQL.Clear;
      SQL.Add('Select Status from System Where Upper(Flag)=:Flag');
      ParamByName('Flag').AsString:=UpperCase(Flag);
      Prepare;
      try
        Open
      except
        ExecSQL;
      end;
      if Not IsEmpty then
      begin
        Result:=FieldByName('Status').AsString;
      end;
      Close;
    end;
  end;
end;

Procedure UpdateSchoolDB(qryPublic:TQuery;Flag,Status:String);
begin
  if Trim(Flag)<>'' then
  begin
    with qryPublic do
    begin
      Close;
      SQL.Clear;
      SQL.Add('Select Name from  School Where Upper(SchoolID)=:Flag');
      ParamByName('Flag').AsString:=UpperCase(Flag);
      Prepare;
      try
        Open;
      except
        ExecSQL;
      end;
      if Not isEmpty then
      begin
        Close;
        SQL.Clear;
        SQL.Add('Update School Set Name=:Status Where Upper(SchoolID)=:Flag');
        ParamByName('Status').AsString:=Status;
        ParamByName('Flag').AsString:=UpperCase(Flag);
        Prepare;
        ExecSQL;
        Close;
      end
      else
      begin
        Close;
        SQL.Clear;
        RequestLive:=True;
        SQL.Add('Select * from School');
        Prepare;
        try
          Open;
        except
          ExecSQL;
        end;
        Append;
        FieldByName('SchoolID').AsString:=Flag;
        FieldByName('Name').AsString:=Status;
        FieldByName('Year').AsString:='2000';
        FieldByName('Semester').AsString:='01';
        FieldByName('DayPW').AsInteger:=0;
        FieldByName('NodePD').AsInteger:=0;
        FieldByName('NodePAM').AsInteger:=0;
        Post;
        Close;
        RequestLive:=False;
      end;
    end;
  end;
end;

Procedure WriteLog(qryPublic:TQuery;LogInfo:TLogInfo);
begin
  with qryPublic do
  begin
    Close;
    SQL.Clear;
    RequestLive:=True;
    SQL.Add('Select * from Log');
    Prepare;
    try
      Open;
    except
      ExecSQL;
    end;
    Append;
    FieldByName('UserName').AsString:=LogInfo.UserName ;
    FieldByName('Operation').AsString:=LogInfo.Operation;
    FieldByName('DDate') .AsDateTime:=LogInfo.DDate ;
    FieldByName('DTime').AsDateTime:=LogInfo.DTime;
    FieldByName('Remark').AsString:=LogInfo.Remark;
    Post;
    Close;
    RequestLive:=False;
  end;
  with qryPublic do
  begin
    Close;
    SQL.Clear;
    SQL.Add('delete from Log Where DDate<=:DDate');
    ParamByName('DDate').AsDate:=Date()-MaxDayCount;
    Prepare;
    ExecSQL;
    Close;
  end;
end;

Function GetSchoolDB(qryPublic:TQuery;Flag:String):String;
begin
  Result:='';
  if Trim(Flag)<>'' then
  begin
    with qryPublic do
    begin
      Close;
      SQL.Clear;
      SQL.Add('Select Name from School Where Upper(SchoolID)=:Flag');
      ParamByName('Flag').AsString:=UpperCase(Flag);
      Prepare;
      try
        Open
      except
        ExecSQL;
      end;
      if Not IsEmpty then
      begin
        Result:=FieldByName('Name').AsString;
      end;
      Close;
    end;
  end;
end;

Function DataParse(Str:String):TDataPacket;
var
  bHigh4,bLow4,bTemp :Byte;
  Char1,Char2,Char3,Char4  :String;
  RawDataPacket      :TRawDataPacket;
begin
  bHigh4:=15;
  bHigh4:=bHigh4 shl 4;
  bLow4:=15;
  With RawDataPacket do
  begin
    Byte1:=Byte(Str[1]);
    Byte2:=Byte(Str[2]);
    Byte3:=Byte(Str[3]);
    Byte4:=Byte(Str[4]);
    Byte5:=Byte(Str[5]);
    Byte6:=Byte(Str[6]);
    DataPacket.ExtensionID:=FormExtensionID(Byte1);
    DataPacket.State:=Byte2;
    bTemp:=Byte3 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char1:=IntToStr(bTemp);
    bTemp:=Byte3 and bLow4;
    Char2:=IntToStr(bTemp);
    bTemp:=Byte4 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char3:=IntToStr(bTemp);
    Char1:=Trim(Char1)+Trim(Char2)+Trim(Char3);
    DataPacket.Gravity:=StrToInt(Char1);
    bTemp:=Byte4 and bLow4;
    Char1:=IntToStr(bTemp);
    bTemp:=Byte5 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char2:=IntToStr(bTemp);
    bTemp:=Byte5 and bLow4;
    Char3:=IntToStr(bTemp);
    bTemp:=Byte6 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char4:=IntToStr(bTemp);
    Char1:=Trim(Char1)+Trim(Char2)+Trim(Char3)+Trim(Char4);
    DataPacket.HeightDiff:=StrToInt(Char1);
  end;
  Result:=DataPacket;
end;

Function ByteParse(ByteData:TByteData):TDataPacket;
var
  bHigh4,bLow4,bTemp :Byte;
  Char1,Char2,Char3  :String;
  RawDataPacket      :TRawDataPacket;
begin
  bHigh4:=15;
  bHigh4:=bHigh4 shl 4;
  bLow4:=15;
  With RawDataPacket do
  begin
    Byte1:=ByteData[1];
    Byte2:=ByteData[2];
    Byte3:=ByteData[3];
    Byte4:=ByteData[4];
    Byte5:=ByteData[5];
    DataPacket.ExtensionID:=FormExtensionID(Byte1);
    DataPacket.State:=Byte2;
    bTemp:=Byte3 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char1:=IntToStr(bTemp);
    bTemp:=Byte3 and bLow4;
    Char2:=IntToStr(bTemp);
    bTemp:=Byte4 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char3:=IntToStr(bTemp);
    Char1:=Trim(Char1)+'.'+Trim(Char2)+Trim(Char3);
    try
      DataPacket.Gravity:=StrToInt(Char1);
    except
      DataPacket.Gravity:=0;
    end;
    bTemp:=Byte4 and bLow4;
    Char1:=IntToStr(bTemp);
    bTemp:=Byte5 and bHigh4;
    bTemp:=bTemp Shr 4;
    Char2:=IntToStr(bTemp);
    bTemp:=Byte5 and bLow4;
    Char3:=IntToStr(bTemp);
    Char1:=Trim(Char1)+Trim(Char2)+Trim(Char3);
    try
      DataPacket.HeightDiff:=StrToInt(Char1);
    except
      DataPacket.HeightDiff:=0;
    end;
  end;
  Result:=DataPacket;
end;

{Function FormSendData(RawCommand :TRawCommand):TSendPacket;
begin
  Result[0]:=StrToInt(RawCommand.ExtensionID);
  Result[1]:=StrToInt(RawCommand.CommandID);
  Result[2]:=FormBCD(RawCommand.Data);
end;}

function FormSendData(RawCommand :TRawCommand):TSendPacket;
var MultiCount,i:integer;
    STemp:string[3];
begin
    MultiCount:=Length(RawCommand.ExtensionID) div 3;
    SetLength(Result,MultiCount+3);
    Result[0]:=MultiCount;
    for i:=1 to MultiCount do
    begin
    STemp:=RawCommand.ExtensionID[i*3-2]+RawCommand.ExtensionID[i*3-1]+RawCommand.ExtensionID[i*3];
    Result[i]:=StrToInt(STemp);
    end;
    Result[MultiCount+1]:=StrToInt(RawCommand.CommandID);
    Result[MultiCount+2]:=0;
end;


Function FormBCD(Data:String):Byte;
var
  strTemp:String;
  ByteTemp:Byte;
begin
  if Length(Data)=1 then
  begin
    Data:=Data+'0';
  end
  else
  begin
    Data:=StringOfChar('0',3-Length(Trim(Data)))+Trim(Data);
    if Pos('.',Data)>0 then
    begin
      Data:=StringReplace(Data,'.','',[rfReplaceAll]);
    end;
  end;
  strTemp:=Data[1];
  Result:=StrToInt(strTemp);
  Result:=Result Shl 4;
  strTemp:=Data[2];
  ByteTemp:=StrToInt(strTemp);
  Result:=Result or ByteTemp;
end;

Function FormExtensionID(iExtension:Integer):String;
begin
  Result:=StringOfChar('0',3-Length(Trim(IntToStr(iExtension))))+Trim(IntToStr(iExtension));
end;
Function GSatisfied(Gravity:Real;Extension:Integer):Boolean;
begin
  Result:=True;
  if ((StandardG[Extension].Value*StateInfo.UpperLimit13)>Gravity) and (((StandardG[Extension].Value*StateInfo.LowLimit07)<Gravity)) then
     Result:=False;
end;

Function GetMaxMinDiff(GroupID:String):TMaxMinExtension;
var
  i :Integer;
  MaxDiff,MinDiff :Real;
  MaxExtension,MinExtension:Integer;
begin
  MaxDiff:=0;
  MinDiff:=999;
  MaxExtension:=0;
  MinExtension:=0;
  for i:=0 to MaxExtensionCount-1 do
  begin
    if AllExtension[i].GroupID=GroupID then
    begin
      if MaxDiff<AllExtension[i].HorizonDiff then
      begin
        MaxDiff:=AllExtension[i].HorizonDiff;
        MaxExtension:=i;
      end;
      if  MinDiff>AllExtension[i].HorizonDiff then
      begin
        MinDiff:=AllExtension[i].HorizonDiff;
        MinExtension:=i;
      end;
    end;
  end;
  Result.HorizonDiff:=Abs(MaxDiff-MinDiff);
  Result.MaxExtensionID:=FormExtensionID(MaxExtension);
  Result.MinExtensionID:=FormExtensionID(MinExtension);
end;

Function GetMaxMinGrivaty(GroupID:String):TMaxMinExtension;
var
  i :Integer;
  MaxGravity,MinGravity :Real;
  MaxExtension,MinExtension:Integer;
begin
  MaxGravity:=0;
  MinGravity:=1000;
  MaxExtension:=0;  //=255
  MinExtension:=0;  //=255
  for i:=0 to MaxExtensionCount-1 do
  begin
    if AllExtension[i].GroupID=GroupID then
    begin
      if MaxGravity<=AllExtension[i].Gravity then
      begin
        MaxGravity:=AllExtension[i].Gravity;
        MaxExtension:=i;
      end;
      if  MinGravity>AllExtension[i].Gravity then
      begin
        MinGravity:=AllExtension[i].Gravity;
        MinExtension:=i;
      end;
    end;
  end;
  Result.HorizonDiff:=0;
  Result.MaxExtensionID:=FormExtensionID(MaxExtension);
  Result.MinExtensionID:=FormExtensionID(MinExtension);
end;

procedure ShowErrorReport(ErrorText:String);
var s:string;
begin
  if frmErrorReport=nil then frmErrorReport:=TfrmErrorReport.Create(Application);
  s:=TimeToStr(Time)+':'+ErrorText;
  with frmErrorReport do
  begin
    Show;
    MemoError.Lines.Add(s);
  end;
end;

//////////////////////////////////////////
initialization

finalization

end.