pmybasedebug.pas

一个有关Delphi 中 UDP协议的实列

  FLoger.ClearTager := 10000;
  FGroupBox := TGroupBox.Create(FBugShowForm);
  FGroupBox.Parent := FBugShowForm;
  FGroupBox.Align := alBottom;
  FGroupBox.Height := 40;
  FGroupBox.Caption := '透明度';
  FtrackBar := TTrackBar.Create(nil);
  FtrackBar.Min := 50;
  FtrackBar.Max := 255;
  FtrackBar.Parent := FGroupBox;
  FtrackBar.Position := 200;
  FtrackBar.Align := alClient;
  FtrackBar.TickStyle := tsNone;
  FtrackBar.OnChange := TrackOnTrack;
  FtrackBar.OnChange(FtrackBar);
  WantAutoSaveLog := False;
  InitDebugSystem;
  AddLogShower(Format('程序启动...', []));
  AddLogShower(Format('程序标题(%s)', [Application.Title]));
  AddLogShower(Format('程序名(%s)', [Application.ExeName]));
end;

destructor TBaseDebug.Destroy;
begin
  AddLogShower(Format('程序结束时间(%s)', [DateTimeToStr(now)]));
  UnInitDebugSystem;
  if WantAutoSaveLog then
    SaveLog();
  FtrackBar.Free;
  FGroupBox.Free;
  FLoger.Free;
  FShower.Free;
  FBugShowForm.Free;
  inherited;
end;

function TBaseDebug.EndLogTIme: Cardinal;
begin
  FEndTime := GetTickCount;
  Result := FEndTime - FStartTime;
end;

procedure TBaseDebug.InitDebugSystem;
begin
  F_gob_openFrom := GlobalAddAtom('Hot_OpenFrom');
  F_gob_AutoLog := GlobalAddAtom('Hot_AutoLog');
  RegisterHotKey(Application.Handle, F_gob_openFrom, MOD_ALT, ord('O'));
  RegisterHotKey(Application.Handle, F_gob_AutoLog, MOD_ALT, ord('P'));
  Application.OnMessage := hotykey;
end;

procedure TBaseDebug.SaveLog(IfileName: string);
begin
  try
    CreateDir(ExtractFilePath(Application.ExeName) + 'DebugLog\');
    FShower.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + 'DebugLog\' + Format('%s', [FormatDateTime('yyyymmddhhnnss', now) + IfileName]));
  except
    raise Exception.Create('保存Debug日志失败');
  end;
end;

procedure TBaseDebug.ShowDebugform;
begin
  FBugShowForm.Show;
  Application.ProcessMessages;
end;

function TBaseDebug.ShowVar(Ivar: Variant): Variant;
var
  S: string;
begin
  try
    Result := Ivar;
    s := Ivar;
    MessageBox(0, Pchar(s), 'Debug', 0);
  except
    on e: Exception do
      AddLogShower(e.Message);
  end;
end;

procedure TBaseDebug.StartLogTime;
begin
  FStartTime := GetTickCount;
end;

procedure TBaseDebug.TrackOnTrack(Iobj: TObject);
begin
  FBugShowForm.AlphaBlendValue := TTrackBar(Iobj).Position;
end;

function TBaseDebug.AddLogShower(IStrings: TStrings): TStrings;
var
  I: Integer;
begin
  Result := IStrings;
  AddLogShower('>>>开始显示Strings Items数量', IStrings.Count);
  for I := 0 to IStrings.Count - 1 do
    AddLogShower(IStrings.Strings[i]);
  AddLogShower('显示Strings结束<<< Items数量', IStrings.Count);
end;

procedure TBaseDebug.UnInitDebugSystem;
begin
  UnregisterHotKey(Application.Handle, F_gob_openFrom);
  UnregisterHotKey(Application.Handle, F_gob_AutoLog);
  GlobalDeleteAtom(F_gob_openFrom);
  GlobalDeleteAtom(F_gob_AutoLog);
end;

procedure TBaseDebug.hotykey(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_HOTKEY then begin
    if loword(Msg.lParam) = MOD_ALT then
      case HiWord(msg.LParam) of //
        ord('o'), Ord('O'): begin
            FBugShowForm.Visible := not FBugShowForm.Visible;
            Application.MainForm.SetFocus;
          end;
        ord('P'), ord('p'): begin
            WantAutoSaveLog := not WantAutoSaveLog;
            AddLogShower('当前自动保存的状态改为： ');
            AddLogShower(WantAutoSaveLog)
          end;
      end; // case
  end;
end;

function TBaseDebug.GetSqlWithTableName(IQuery: TADOQuery;
  ItabName: string; Issk: SCreateSqlKind): string;
begin
  with IQuery do begin
    Close;
    SQL.Text := Format('Select * from %s Where 1=2', [ItabName]);
    try
      Open;
      case Issk of //
        SSk_insert: Result := CreateInsertSql(IQuery.Fields, ItabName);
        SSk_update: Result := CreateUpdateSql(IQuery.Fields, ItabName);
      end; // case
    except
      on e: Exception do
        AddLogShower('生成语句函数读取数据库时异常,语句生成失败', e.Message);
    end;
  end; // with
end;

function TBaseDebug.CreateInsertSql(IdataSet: TFields; ItabName: string): string;
var
  I: Integer;
  LList: TStringList;
begin
  LList := TStringList.Create;
  with IdataSet do begin
    Result := 'Insert into ' + ItabName + '(';
    for I := 0 to Count - 1 do begin // Iterate
      Result := Result + Fields[i].FieldName;
      case Fields[i].DataType of
        ftCurrency, ftBCD, ftSmallint, ftWord, ftInteger, ftBytes: LList.Add('%d');
        ftFloat: LList.Add('%f');
      else LList.Add('''%s''');
      end; // case
      if i <> Count - 1 then
        Result := Result + ',';
    end; // for
    Result := Result + ') Values(';
    for I := 0 to LList.Count - 1 do begin // Iterate
      Result := Result + LList.Strings[i];
      if i <> LList.Count - 1 then
        Result := Result + ',';
    end; // for
    Result := Result + ')';
  end; // with
  LList.Free;
end;

function TBaseDebug.CreateUpdateSql(IdataSet: TFields; ItabName: string): string;
var
  I: Integer;
begin
  with IdataSet do begin
    Result := 'Update ' + ItabName + ' Set ';
    for I := 0 to Count - 1 do begin // Iterate
      Result := Result + Fields[i].FieldName + '=';
      case Fields[i].DataType of //
        ftCurrency, ftBCD, ftSmallint, ftWord, ftInteger, ftBytes: Result := Result + '%d';
        ftFloat: Result := Result + '%d'
      else Result := Result + '''%s''';
      end; // case
      if i <> Count - 1 then
        Result := Result + ',';
    end; // for
  end; // with
end;

function TBaseDebug.AddLogShower(IDateset: TDataSet; IshowKind: SShowKind;
  IshowNumber: Integer): TDataSet;
var
  I, N, tot: Integer;
  LTep: string;
begin
  Result := IDateset;
  AddLogShower('>>>开始显示DataSet');
  AddLogShower('数据集%s打开与否:%s', [IDateset.Name, BoolToStr(IDateset.Active, True)]);
  AddLogShower('总记录数', IDateset.RecordCount);
  AddLogShower('当前记录数', IDateset.RecNo);
  AddLogShower('记录大小', IDateset.RecordSize);
  if IshowKind <> Sshowkind_None then begin
    AddLogShower('开始显示数据集记录>>>');
    for I := 0 to IDateset.Fields.Count - 1 do
      LTep := LTep + ' | ' + IDateset.Fields[i].FieldName;
    AddLogShower(LTep);
    if IshowKind = Sshowkind_FieldHead then begin
    end
    else if IshowKind = Sshowkind_CurrNo then begin
      LTep := '';
      for I := 0 to IDateset.Fields.Count - 1 do
        LTep := LTep + ' | ' + IDateset.Fields[i].AsString;
      AddLogShower(LTep);
    end
    else begin
      if IshowKind = Sshowkind_All then
        tot := IDateset.RecordCount
      else tot := IshowNumber;
      IDateset.First;
      for I := 0 to tot - 1 do begin
        LTep := '';
        for N := 0 to IDateset.FieldCount - 1 do
          LTep := LTep + ' | ' + IDateset.Fields[n].AsString;
        AddLogShower(LTep);
        IDateset.Next;
      end;
    end;
  end;
  AddLogShower('显示DataSet完毕<<<');
end;

function TBaseDebug.AddLogShower(IStr: string; const Args: array of const):
  Variant;
begin
  try
    IStr := Format(IStr, Args);
    Result := IStr;
    FLoger.AddShow(Result);
  except
    on e: Exception do
      AddLogShower(e.Message);
  end;
end;

initialization
  Gob_Debug := TBaseDebug.Create;
finalization
  Gob_Debug.Free;
end.