pmybasedebug.pas

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

unit PMyBaseDebug;
{
单元名：PMyBaseDebug
创建者：马敏钊
创建日期：20050407
类：TBaseDebug
功能描述：
   提供基本的Debug方法 和日志显示记录的功能
   本单元自己维护一个全局变量Gob_Debug
20050412
  添加了TBaseDebug 的自动注册热键的能力
  将公开的 方法 InitDebugSystem(ImainForm: TForm)改为私有
  添加了窗体透明的拖动条
  添加了一个方法
  Function AddLogShower(IStrings:TStringList): Variant; Overload;
  将 FShower: TMemo;改为私有
  将 AutoSaveLog: boolean; 改名为 WantAutoSaveLog: boolean;
20050518
  添加了显示TDATASET的函数
  添加根据表名生成插入和更新SQL语句的函数
20051128
  添加一个累加记数的方法
  去掉了没多少用的接口ISHOWER
}

interface
uses Windows, SysUtils, Classes, Messages, Controls, Forms, StdCtrls, ExtCtrls,
  ComCtrls, DB, ADODB;
const
   {分割符号}
  CSplitStr = '===============================================================';
  ClogFileName = '.log';
type
  TDebugLogFile = class
  private
    FFileParth: string; //路径
    FText: Text;
    FIsCreateToNew: boolean; //是否是每次启动程序都创建新的记录文件 否则就是当天只会有1个文件
  public
    {带入日志文件存放的目录位置}
    constructor Create(Iparth: string);
    destructor Destroy; override;
    {写入内容即可自动记录}
    procedure AddLog(Icon: string);
    property IsCreateToNew: boolean read FIsCreateToNew write FIsCreateToNew;
  end;
  {
   显示接口
  }
  TEventShowed = procedure(ILogCon: string) of object;
  TDebuglog = class
  private
    FShower: TComponent; //容器
    FClearTager: Word; //显示多少条后清空一下
    FIsAddTime: boolean; //是否在每条显示前加时间
    FAfterShowed: TEventShowed; //显示后触发的事件 可以用来做日志
    FIsNeedSplt: boolean; //是否需要分割字符
    FSplitChar: string; //分割的字符
    FLog: TDebugLogFile;
  protected
    function DoAdd(Icon: string): Integer; virtual;
    function AddShow(ICon: string): Integer;
  published
    property AfterShowed: TEventShowed read FAfterShowed write FAfterShowed;
  public
    {如果带入记录文件存放路径的话就自动生成记录类}
    constructor Create(IShower: TComponent; IlogFIleDir: string = '');
    destructor Destroy; override;
    property ClearTager: Word read FClearTager write FClearTager;
    property IsAddTime: boolean read FIsAddTime write FIsAddTime;
    property IsNeedSplitChar: boolean read FIsNeedSplt write FIsNeedSplt;
    property SplitChar: string read FSplitChar write FSplitChar;
  end;

type
  //生成语句类型
  SCreateSqlKind = (SSk_insert, SSk_update);
  //显示类型
  SShowKind = (Sshowkind_None, Sshowkind_FieldHead, Sshowkind_Number, Sshowkind_All, Sshowkind_CurrNo);
  TBaseDebug = class
  private
    FStartTime,
      FEndTime: Cardinal;
    FBugShowForm: TForm;
    FLoger: TDebugLog;
    FtrackBar: TTrackBar;
    FGroupBox: TGroupBox;
    FShower: TMemo;
    F_gob_openFrom, F_gob_AutoLog: Integer;
    {加载热键系统 Alt+o 是打开debug窗体 +p是打开/关闭自动记录功能}
    procedure InitDebugSystem;
    {释放系统热键}
    procedure UnInitDebugSystem;
    {拖动滚动条}
    procedure TrackOnTrack(Iobj: TObject);
    {Hotkey}
    procedure hotykey(var Msg: TMsg; var Handled: Boolean);
    {根据TDATASET生成插入语句}
    function CreateInsertSql(IdataSet: TFields; ItabName: string): string;
    {根据TdataSet生成查询语句}
    function CreateUpdateSql(IdataSet: TFields; ItabName: string): string;
  public
    {是否在程序结束的时候自动保存除错信息 默认是False}
    WantAutoSaveLog: boolean;

    {开始记录时间}
    procedure StartLogTime;
    {停止记录并且返回时间差单位毫秒}
    function EndLogTIme: Cardinal;
    {弹出变量的值}
    function ShowVar(Ivar: Variant): Variant;
    {添加到Log容器}
    function AddLogShower(Ivar: Variant): Variant; overload;
    function AddLogShower(IStr: string; const Args: array of const): Variant; overload;
    function AddLogShower(IDesc: string; Ivar: Variant): Variant; overload;
    function AddLogShower(IStrings: TStrings): TStrings; overload;
    function AddLogShower(IDateset: TDataSet; IshowKind: SShowKind = Sshowkind_None; IshowNumber: Integer = 0): TDataSet; overload;
    {根据表名自动生成SQL}
    function GetSqlWithTableName(IQuery: TADOQuery; ItabName: string; Issk: SCreateSqlKind): string;
    {显示Debug窗体}
    procedure ShowDebugform;
    {将所有记录的东东保存成日志}
    procedure SaveLog(IfileName: string = 'LogFile.log');
    constructor Create;
    destructor Destroy; override;
  end;
var
  Gob_Debug: TBaseDebug;
implementation

{ TDebugLog }

function TDebugLog.AddShow(ICon: string): Integer;
begin
  if FIsAddTime then
    ICon := DateTimeToStr(Now) + ' ' + Icon;
  if FIsNeedSplt then
    ICon := ICon + #13#10 + FSplitChar;
  Result := DoAdd(ICon);
  if assigned(FLog) then
    FLog.AddLog(ICon);
  if Assigned(FAfterShowed) then
    FAfterShowed(ICon);
end;

constructor TDebugLog.Create(IShower: TComponent; IlogFIleDir: string = '');
begin
  FClearTager := 1000;
  IsAddTime := True;
  FIsNeedSplt := True;
  FSplitChar := CSplitStr;
  FShower := IShower;
  if IlogFIleDir <> '' then
    FLog := TDebugLogFile.Create(IlogFIleDir);
end;

destructor TDebugLog.Destroy;
begin
  if assigned(FLog) then
    FLog.Free;
  inherited;
end;

function TDebugLog.DoAdd(Icon: string): Integer;
begin
  if (FShower is TMemo) then begin
    Result := TMemo(FShower).Lines.Add(Icon);
    if Result >= FClearTager then TMemo(FShower).Clear
  end
  else if (FShower is TListBox) then begin
    Result := TListBox(FShower).Items.Add(Icon);
    if Result >= FClearTager then TListBox(FShower).Clear
  end
  else
    raise Exception.Create('默认容器错误:' + FShower.ClassName);
end;

{ TDebugLogFile }

procedure TDebugLogFile.AddLog(Icon: string);
begin
  try
    Append(FText);
    Writeln(FText, icon);
  except
    IOResult;
  end;
end;

constructor TDebugLogFile.Create(Iparth: string);
var
  Ltep: string;
begin
  FIsCreateToNew := True;
  FFileParth := Iparth;
  if not DirectoryExists(FFileParth) then
    if not CreateDir(FFileParth) then begin
      raise Exception.Create('错误的路径，日志类对象不能被创建');
      exit;
    end;
  Ltep := FormatDateTime('yyyymmddhhnnss', Now);
  FileClose(FileCreate(FFileParth + ltep + ClogFileName));
  AssignFile(FText, FFileParth + ltep + ClogFileName);
end;

destructor TDebugLogFile.Destroy;
begin
  try
    CloseFile(FText);
  except
  end;
  inherited;
end;

{ TBaseDebug }

function TBaseDebug.AddLogShower(Ivar: Variant): Variant;
begin
  try
    Result := Ivar;
    FLoger.AddShow(Ivar);
  except
    on e: Exception do
      AddLogShower(e.Message);
  end;
end;

function TBaseDebug.AddLogShower(IDesc: string; Ivar: Variant): Variant;
var
  Ltep: string;
begin
  try
    Ltep := Ivar;
    Result := Ivar;
    FLoger.AddShow('描述<' + IDesc + '> <值: ' + Ltep + '>');
  except
    on e: Exception do
      AddLogShower(e.Message);
  end;
end;

constructor TBaseDebug.Create;
begin
  FBugShowForm := TForm.Create(FBugShowForm);
  FBugShowForm.FormStyle := fsStayOnTop;
  FBugShowForm.Caption := '小草的Debug系统';
  FBugShowForm.Visible := False;
  FBugShowForm.Position := poScreenCenter;
  FBugShowForm.AlphaBlend := True;
  FBugShowForm.Width := 430;
  FBugShowForm.Height := 300;
  FShower := TMemo.Create(FBugShowForm);
  FShower.Parent := FBugShowForm;
  FShower.Align := alClient;
  FShower.ScrollBars := ssVertical;
  FShower.WordWrap := True;
  FLoger := TDebugLog.Create(FShower);
  FLoger.IsNeedSplitChar := False;