基础线程类－－备忘

 

COMMON
unit Common;

interface

uses Classes,SysUtils,windows,iniFiles;

const
  Config_File = '.\Config.ini';
  DBParam_File = '.\Oracle.bin';
  Log_No = 0;
  Log_Fail = 1;
  Log_All = 3;

type
  TMapNode = record
     key:string;
     value:string;
  end;

  TMap = class
  private
    FKeyMap : Tstringlist;
    FValueMap: TstringList;
    Fcount : integer;
    function Get(Index: Integer): TMapNode;
    function GetCount:integer;
  public
    property Count: integer read GetCount;
    property Map[Index: Integer]: TMapNode read Get ; default;
    Constructor Create;
    destructor Destroy; override;
    procedure Add(key,value:string);         //include Update
    function getvalue(key:string):string;
    function indexof(key:string):integer;
  end;  

  TConfig = class
  private
   FiniFile: TIniFile;
  public
    Class Function Instance:Tconfig;
    Constructor Create;
    destructor Destroy; override;
    function ReadInteger(const Section, Ident: String; Default: Longint):Longint;
    function ReadBool(const Section, Ident: String; Default: Boolean): Boolean;
    function ReadString(const Section, Ident, Default: String): String;
    procedure ReadSection(const Section: string; Strings: TStrings);
    procedure WriteBool(const Section, Ident: String; Value: Boolean);
    procedure WriteInteger(const Section, Ident: String; Value: Longint);
    procedure WriteString(const  Section, Ident, Value: String);
  end;

  TBuffer = class
  private
    FBuffer: TStrings;
    FCount : integer;
  public
    property Count: integer read fCount;
    Constructor Create;
    destructor Destroy;  override;
    procedure Add(Msg:string);
    procedure ReInsert(Msg:string);
    function Getdata:string;
    procedure DeleteData;
  end;

  TSyncBuffer = class
  private
    FBuffer : TStrings;
    Fcount : Integer;
    Critical1 : TRTLCriticalSection;
  public
    property Count: integer read fCount;
    Constructor Create;
    destructor Destroy;  override;
    procedure Add(Msg:string);
    procedure ReInsert(Msg:string);
    function GetData:string;
  end;

  TLog = class
  private
    FFileName:string;
    FlogSwitch:integer;
  public
    class function GetFileName(FileName:string):string;
    procedure Log(str: String;logtype: Integer); //记录日志
    Constructor Create(FileName:string;logSwitch:integer);
  end;

implementation

var ConfigFile:TConfig;

{ TContext }

procedure TBuffer.Add(Msg: string);
begin
    fbuffer.Append(Msg);
    fcount := fbuffer.Count;
end;


constructor TBuffer.Create;
begin
    fbuffer := Tstringlist.Create;
    fcount := 0
end;

procedure TBuffer.deletedata;
begin
    fbuffer.Delete(0);
    fcount := fbuffer.Count;
end;

destructor TBuffer.Destroy;
begin
  fbuffer.Free;
  inherited;
end;

function TBuffer.Getdata: string;
var Msg:string;
begin
    msg := fbuffer[0];
    result := msg;
end;

procedure TBuffer.ReInsert(Msg: string);
begin
      FBuffer.Insert(0,Msg);
  fcount := fbuffer.Count;
end;

{ TLog }

constructor TLog.Create(FileName: string; logSwitch: integer);
begin
   FFileName := FileName;
   flogSwitch := logSwitch;
end;



class function TLog.GetFileName(FileName: string): string;
begin
  result := '..\Log\'+formatdatetime('yyyymmdd',now)+'\'+FileName+'.MES';
end;

procedure TLog.Log(str: String; logtype: Integer);
var
   F: TextFile;
   FileName: String;
begin
  //记录系统日志
  if (flogSwitch and logtype) = LogType then  begin
      FileName := '..\Log\'+formatdatetime('yyyymmdd',now);
      if not directoryexists(filename) then
         ForceDirectories(filename);
      FileName := filename+'\'+FFileName+'.MES';
      Assignfile(F,FileName);
      {$I-}
      Append(F);
      while True do
      begin
         case IOResult of
            0: Break; //open ok
            2: ReWrite(F);
         else
            Append(F);
         end;
      end;
      {$I+}
      Writeln(F,DateTimeToStr(Now)+' | '+str);
      CloseFile(F);
  end;
end;

{ TMap }

procedure TMap.Add(key, value: string);
var index:integer;
begin
  index :=  FKeymap.IndexOf(key);
  if index > -1 then
    Fvaluemap[index] := value
  else begin

  FKeymap.Add(key);
  Fvaluemap.Add(value);
  Fcount := FKeymap.Count;
    end;
end;

constructor TMap.Create;
begin
  FKeymap := TStringlist.Create;
  Fvaluemap := TStringlist.Create;
  Fcount := 0;
 // Fmap.Sorted := true;
end;

destructor TMap.Destroy;
begin
  FKeymap.Free;
  Fvaluemap.Free;
  inherited;
end;



function TMap.Get(Index: Integer): TMapNode;
var temp:TMapNode;
begin
  if index > Fcount -1 then begin
    temp.key := '';
    temp.value := '';
    result := temp;
  end else begin
  temp.key := FKeymap[index];
  temp.value := Fvaluemap[index];
  result := temp;
  end;
end;

function TMap.GetCount: integer;
begin
  if Assigned(self) then result := Fcount    //HOHO 未初始化本对象
  else result := 0;

end;

function TMap.getvalue(key: string): string;
var i:integer;
begin
  i:= FKeymap.IndexOf(key);
  if i > -1 then
    result := Fvaluemap[i]
  else
    result := 'N/A';
end;

function TMap.indexof(key: string): integer;
begin
  result :=   FKeymap.IndexOf(key);
end;

{ TSyncBuffer }

procedure TSyncBuffer.Add(Msg: string);
begin
    EnterCriticalSection(Critical1);
    fbuffer.Append(Msg);
    fcount := fbuffer.Count;
    LeaveCriticalSection(Critical1);
end;

constructor TSyncBuffer.Create;
begin

    InitializeCriticalSection(Critical1);
    fbuffer := Tstringlist.Create;
    fcount := 0;
end;

destructor TSyncBuffer.Destroy;
begin
  fcount := 0;
  fbuffer.Free;
  DeleteCriticalSection(Critical1);
  inherited;
end;

function TSyncBuffer.getdata: string;
var Msg:string;
begin
        EnterCriticalSection(Critical1);
    msg := fbuffer[0];
    fbuffer.Delete(0);
    fcount := fbuffer.Count;
    result := msg;
        LeaveCriticalSection(Critical1);
end;

procedure TSyncBuffer.ReInsert(Msg: string);
begin
    EnterCriticalSection(Critical1);
    FBuffer.Insert(0,Msg);
    fcount := fbuffer.Count;
     LeaveCriticalSection(Critical1);

end;

{ TConfig }

constructor TConfig.Create;
begin
  Finifile := TIniFile.Create(Config_File);
end;

destructor TConfig.Destroy;
begin
  FiniFile.Free;
  FiniFile := nil;
  ConfigFile := nil;
  inherited;
end;

class function TConfig.Instance: Tconfig;
begin
      if not Assigned(ConfigFile) then
     ConfigFile := Tconfig.Create;
   result:= ConfigFile;
end;

function TConfig.ReadBool(const Section, Ident: String;
  Default: Boolean): Boolean;
begin
 result:= FiniFile.ReadBool(Section,Ident,Default);
end;

function TConfig.ReadInteger(const Section, Ident: String;
  Default: Integer): Longint;
begin
  result:= FiniFile.ReadInteger(Section,Ident,Default);
end;

procedure TConfig.ReadSection(const Section: string; Strings: TStrings);
begin
  FiniFile.ReadSection(Section,strings);
end;

function TConfig.ReadString(const Section, Ident, Default: String): String;
begin
  result:= FiniFile.ReadString(Section,Ident,Default);
end;

procedure TConfig.WriteBool(const Section, Ident: String; Value: Boolean);
begin
  FiniFile.WriteBool(Section,Ident,Value);
end;

procedure TConfig.WriteInteger(const Section, Ident: String;
  Value: Integer);
begin
     FiniFile.WriteInteger(Section,Ident,Value);
end;

procedure TConfig.WriteString(const Section, Ident, Value: String);
begin
   FiniFile.WriteString(Section,Ident,Value);
end;

end.

BaseThread
unit BaseThread;

interface

uses Classes,SysUtils,Common;


type
 // TAddEvent = procedure(msg:string);
  TOnThreadProcessEvent = procedure(flog:Tlog;fmsg:string);
  TOnThreadBeforeEvent = Function(flog:Tlog;fmsg:string):string;
  TOnThreadShowMsg = procedure(FMsg:string) ;


  TBaseThread = class(TThread)
  protected
 //   FTargetAdd : TAddEvent;
    FName :string;
    Flog: Tlog;
    FOnThreadProcessEvent :TOnThreadProcessEvent;
    FOnThreadBeforeEvent :TOnThreadBeforeEvent;
    FOnThreadShowMsg : TOnThreadShowMsg;
  public
 //   property AddEvent : TAddEvent read FTargetAdd write FTargetAdd;
    property Name :string read FName;
    property OnThreadProcessEvent:TOnThreadProcessEvent read FOnThreadProcessEvent write FOnThreadProcessEvent;
    property OnThreadBeforeEvent :TOnThreadBeforeEvent read FOnThreadBeforeEvent write FOnThreadBeforeEvent;
    property  OnThreadShowMsg : TOnThreadShowMsg read FOnThreadShowMsg write FOnThreadShowMsg;
    procedure Add(Msg:string); virtual; abstract;
    function GetStatus:string;virtual;
  end;

  TProcessThread = class(TBaseThread)
      private
        FBuffer: TBuffer;
      protected
        procedure Execute;   override;
        procedure Terminatedevent(sender:Tobject);
      public
        procedure Add(Msg:string); override;
        Constructor Create(Name:string;suspendflag:boolean;logSwitch:integer);
  end;

implementation


procedure TProcessThread.Add(Msg: string);
begin
  Fbuffer.Add(msg);
  resume;
end;


constructor TProcessThread.Create(Name: string; suspendflag: boolean;
  logSwitch: integer);
begin
  Fname := name;
  FBuffer := TBuffer.Create;
  Flog := Tlog.Create(name,logswitch);
  onterminate := terminatedevent;
  FreeOnTerminate:=true;
  Flog.Log(name+'线程对象创建',log_all);
  inherited create(suspendflag);        //建立后先挂起
end;

procedure TProcessThread.Execute;
var temp :string;
begin
   while True do begin
      if Terminated then break;
      if Fbuffer.Count > 0 then begin
         temp := Fbuffer.Getdata; Fbuffer.deletedata;
         if Assigned(FOnThreadBeforeEvent) then temp:=FOnThreadBeforeEvent(Flog,temp);
         flog.Log('处理数据:'+temp,log_all);
         if Assigned(FOnThreadProcessEvent) then FOnThreadProcessEvent(Flog,temp);
      end else
        suspend;
   end;
end;

procedure TProcessThread.Terminatedevent(sender: Tobject);
begin
  fbuffer.Free;
  Flog.log(FName+'线程释放',log_all);
  Flog.Free;
end;

{ TBaseThread }

function TBaseThread.GetStatus: string;
begin
  result := '';
end;

end.