untfunctions.pas

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

{*******************************************************}
{      单元名：  untFunctions.pas                       }
{      创建日期：2006-01-06 9:07:22                     }
{      创建者    马敏钊 QQ 22900104                     }
{      功能：    提供公共的方法                         }
{                                                       }
{*******************************************************}

unit untFunctions;

interface
//------------------------------------------------------------------------------
// 根据此配置文件决定编译那些函数
//------------------------------------------------------------------------------
{$DEFINE Db}  //数据库操作函数
{$DEFINE File}//文件操作函数
{.$DEFINE Graph}//图形操作函数
{$DEFINE dialog}//对话筐
{$DEFINE List}//列表
{$DEFINE Zlib}//压缩


uses SysUtils

{$IFDEF dialog}
  , dialogs
  , Controls
{$ENDIF}

{$IFDEF Db}
  , Contnrs
  , Variants
  , adodb, db
{$ENDIF}

{$IFDEF File}
  , Windows
  , Forms
{$ENDIF}

{$IFDEF Graph}
  , Graphics
{$ENDIF}

{$IFDEF List}
  , Classes
{$ENDIF}

{$IFDEF ZLib}
  , ZLib
{$ENDIF}
  ;

//------------------------------------------------------------------------------
// 数据库
//------------------------------------------------------------------------------

{$IFDEF Db}
const
  CDb_State_NoneUsed = '';
  CDb_State_EverUsed = -1;
  CDb_State_CanUsed = 0;
//------------------------------------------------------------------------------
// 数据库操作类
//------------------------------------------------------------------------------
type
  {检查ADO是否可用的线程}
  TDBMrg = class;

  TCheckThread = class(TThread)
  private
    CheckTime: Cardinal;
  public
    DbMrg: TDbmrg;
    procedure Execute; override;
    constructor Create(IsStop: boolean; IDbMrg: TDbmrg);
  end;
  TDBMrg = class
  private
    FConn: TADOConnection;
    FPool: TStringList;
    FName: Integer;
    FAutoFreeConn: boolean;
    FTotCount: Integer;
    FThread_Check: TCheckThread;
  public
    {一个公共的BUff 启动时未创建}
    TepBuff: TADOQuery;
    property TotCount: Integer read FTotCount write FTotCount;
    constructor Create(IConStr: string; ICreateBuffCount: Integer = 5); overload;
    constructor Create(IConn: TADOConnection; ICreateBuffCount: Integer = 5);
      overload;
    destructor Destroy; override;
    {获取一个ADO对象 可以指定名字 如果没有名字 系统自己返回一合适的对象}
    function GetAnQuery(IuserTime: integer = 1; Iname: string = ''): TADOQuery; overload;
    function GetAnQuery(Iname: string): TADOQuery; overload;
    {获取自动增长的ID号码}
    function GetId(ItabName, IFieldName: string): Integer;
    {获取符合记录的个数}
    function GetCount(ItabName, IFieldName: string; Ivalue: variant): Cardinal;
      overload;
    function GetCount(ItabName: string): Cardinal; overload;
    {根据字段名和值删除表内容}
    procedure DeleteSomeThing(ItabName, IFieldName: string; Ivalue: Variant);
    {读取某个字段的值}
    function GetSomeThing(ItabName, IGetField, IWhereField: string; Ivalue: Variant): variant;
    {判断是否已经存在这个值}
    function IsExitThis(ItabName, IFieldName: string; Ivalue: Variant): boolean;
    {在数据集内定位记录}
    function FindDataInDataSet(IData: TDataSet; IFieldName, IFieldValue: string; Iopt: TLocateOptions): boolean;
    {执行一个语句}
    function ExecAnSql(Isql: string): Integer; overload;
    function ExecAnSql(Isql: string; const Args: array of const): Integer; overload;
    function ExecAnSql(IQueryRight: integer; Isql: string; const Args: array of const): Integer; overload;
    {执行一个查询语句}
    function OpenDataset(ISql: string): TADOQuery; overload;
    {用指定的ＡＤＯ执行}
    function OpenDataset(IadoName, ISql: string): TADOQuery; overload;
    function OpenDataset(Iado: TADOQuery; ISql: string; const Args: array of const):
      TADOQuery; overload;
    function OpenDataset(ISql: string; const Args: array of const): TADOQuery; overload;
    function OpenDataset(IQueryRight: integer; ISql: string; const Args: array of
      const): TADOQuery; overload;
    {释放ADO使用权以便其它人员使用}
    procedure BackToPool(Iado: TADOQuery); overload;
    procedure BackToPool(IName: string); overload;
    {加入一个由外部创建的ADO 帮它管理生命周期和重用}
    procedure AddAnOutAdo(Iado: TADOQuery);
    {为操作表预备一个ADO}
    function Ready(ItabName: string; Iado: TADOQuery): TADOQuery; overload;
    function Ready(ItabName: string; IQueryRight: integer = 1): TADOQuery; overload;
    {打开一个表}
    function OpenTable(ItabName: string; Iado: TADOQuery): TADOQuery; overload;
    function OpenTable(ItabName: string; IQueryRight: integer = 1): TADOQuery; overload;

    {检查是否处于可修改状态}
    function CheckModState(IAdo: TADOQuery): boolean;
    {安全保存}
    function SafePost(Iado: TADOQuery): boolean;
    {查询总共有多少个ADOquery}
    function PoolCount: Integer;
    {空闲着的ADO数量}
    function PoolFreeCount: Integer;
    {获取连接}
    function GetConn: TADOConnection;
    {获取ACCESS连接字符串}
    class function GetAccessConnStr(IDataSource: string; Ipsd: string = ''): string;
    {获取MSSQL连接字符串}
    class function GetMsSQLConnStr(IDataSource, IAcc, Ipsd, IDataBase: string): string;
    {获取Oracle连接字符串}
    class function GetOracleConnStr(IDataSource, IAcc, Ipsd: string): string;
    {获取Excel连接字符串}
    class function GetExcelConnStr(IFileName: string): string;
    {获取Text连接字符串}
    class function GetTextConnStr(IDBPath: string): string;
    {获取Dbf连接字符串}
    class function GetDBFConnStr(IDBPath: string): string;
    {获取MySQl连接字符串}
    class function GetMySqlConnStr(IDataSource, IDbName, IAcc, Ipsd: string): string;
  end;
//------------------------------------------------------------------------------
// 一个全局的变量
//------------------------------------------------------------------------------
var
  Gob_DBMrg: TDBMrg = nil;
  {判断变体是是空就返回0或者''}
function IsNullReturnint(Ivar: Variant): Integer;
function IsNullReturnFloat(Ivar: Variant): Double;
function IsNullReturnStr(Ivar: Variant): string;
{$ENDIF}

//------------------------------------------------------------------------------
// 对话筐
//------------------------------------------------------------------------------
{$IFDEF dialog}
{几个常用的对话筐}
function QueryInfo(Info: string): Boolean;
procedure ErrorInfo(Info: string); overload;
procedure ErrorInfo(Info: string; const Args: array of const); overload;
procedure WarningInfo(Info: string);
procedure TipInfo(Info: string);
procedure ExceptTip(Info: string);
procedure ExceptionInfo(Info: string);
var
  ShowDeBug: Boolean = True; {是否显示Debug信息}
procedure DeBug(ICon: Variant); overload;
procedure DeBug(ICon: string; const Args: array of const); overload;

{$ENDIF}
//------------------------------------------------------------------------------
// 列表
//------------------------------------------------------------------------------
{$IFDEF List}
{清除列表}
procedure ClearList(IList: TStrings);
{添加到列表}
procedure AddList(Ilist: Tstrings; ICapTion: string; Iobj: TObject);
{获取选中对象}
function GetObj(Ilist: TStrings; Iidx: Integer): TObject;
{分割字符串}
procedure GetEveryWord(S: string; E: TStrings; C: string);
{获取文件名称}
function GetOnlyFileName(IfileName: string): string;
{$ENDIF}
//------------------------------------------------------------------------------
// 图形
//------------------------------------------------------------------------------
{$IFDEF Graph}
{RGBTODElphiColor}
function RGB2BGR(C: Cardinal): TColor;
{DelphiColorTORGB}
function BGR2RGB(C: TColor): Cardinal;
{$ENDIF}
//------------------------------------------------------------------------------
// 文件
//------------------------------------------------------------------------------

{$IFDEF File}
{文件是否在使用中}
function IsFileInUse(FName: string): Boolean;
{取Windows系统目录}
function GetWindowsDir: string;
{取临时文件目录}
function GetWinTempDir: string;
{查找指定目录下文件}
procedure FindFileList(Path, Filter: string; FileList: TStrings; ContainSubDir: Boolean);
{$ENDIF}


{$IFDEF ZLib}
procedure EnCompressStream(CompressedStream: TMemoryStream);
procedure DeCompressStream(CompressedStream: TMemoryStream);

{$ENDIF}

//------------------------------------------------------------------------------
// 公共函数
//------------------------------------------------------------------------------
{IFTHen}
function IfThen(AValue: Boolean; const ATrue: Integer; const AFalse: Integer = 0): Integer; overload;
function IfThen(AValue: Boolean; const ATrue: Int64; const AFalse: Int64 = 0): Int64; overload;
function IfThen(AValue: Boolean; const ATrue: Double; const AFalse: Double = 0.0): Double; overload;
function IfThen(AValue: Boolean; const ATrue: string; const AFalse: string = ''): string; overload;
function IfThen(AValue: Boolean; const ATrue: boolean; const AFalse: boolean): boolean; overload;

{*随机字符串}
function RandomStr(aLength: Longint): string;
{*缩短路径显示}
function FormatPath(APath: string; Width: Integer): string;
{当前项目的路径}
function GetCurrPath: string;
{判断是否都是数字}
function IsallNumber(IStr: string): boolean;
{获取格式化的当前时间}
function GetFormatTime: string;
{获取格式化的当前日期和时间}
function GetDocTime: string;
{获取格式化的当前日期}
function GetFormatDate: string;
{获取格式化的当前日期}
function GetDocDate: string;
{获取日期和时间}
function GetFormatDateTime: string;
{设置系统时间}
function SetSystime(ATime: TDateTime): boolean;

{程序只运行一个实列}
function AppRunOnce: Boolean;

{字符串简单加密}
function Str_Encry(ISrc: string; key: string = 'mMz'): string;
{字符串简单解密}
function Str_Decry(ISrc: string; key: string = 'mMz'): string;
{获取硬盘剩余空间情况}
function GetDiskInfo(IdiskName: string): string;
{取文件长度}
function GetFileSize(FileName: string): Integer;
function GetFileSize64(const FileName: string): Int64;

implementation

{$IFDEF ZLib}
{-------------------------------------------------------------------------------
  过程名:    EnCompressStream
  作者:      马敏钊
  日期:      2006.03.01
  参数:      CompressedStream: TMemoryStream
  返回值:    无
  说明:     流压缩函数
-------------------------------------------------------------------------------}

procedure EnCompressStream(CompressedStream: TMemoryStream);
var
  SM: TCompressionStream;
  DM: TMemoryStream;
  Count: int64; //注意，此处修改了,原来是int
begin
  if CompressedStream.Size <= 0 then exit;
  CompressedStream.Position := 0;
  Count := CompressedStream.Size; //获得流的原始尺寸
  DM := TMemoryStream.Create;
  SM := TCompressionStream.Create(clMax, DM);
  try
    CompressedStream.SaveToStream(SM); //SourceStream中保存着原始的流
    SM.Free; //将原始流进行压缩，DestStream中保存着压缩后的流
    CompressedStream.Clear;
    CompressedStream.WriteBuffer(Count, SizeOf(Count)); //写入原始文件的尺寸
    CompressedStream.CopyFrom(DM, 0); //写入经过压缩的流
    CompressedStream.Position := 0;
  finally
    DM.Free;
  end;
end;


{-------------------------------------------------------------------------------
  过程名:    DeCompressStream
  作者:      马敏钊
  日期:      2006.03.01
  参数:      CompressedStream: TMemoryStream
  返回值:    无
  说明:      解压缩函数
-------------------------------------------------------------------------------}

procedure DeCompressStream(CompressedStream: TMemoryStream);
var
  MS: TDecompressionStream;
  Buffer: PChar;
  Count: int64;
begin
  if CompressedStream.Size <= 0 then exit;
  CompressedStream.Position := 0; //复位流指针
  CompressedStream.ReadBuffer(Count, SizeOf(Count));
  //从被压缩的文件流中读出原始的尺寸
  GetMem(Buffer, Count); //根据尺寸大小为将要读入的原始流分配内存块
  MS := TDecompressionStream.Create(CompressedStream);
  try
    MS.ReadBuffer(Buffer^, Count);
    //将被压缩的流解压缩，然后存入 Buffer内存块中
    CompressedStream.Clear;
    CompressedStream.WriteBuffer(Buffer^, Count); //将原始流保存至 MS流中
    CompressedStream.Position := 0; //复位流指针
  finally
    FreeMem(Buffer);
    MS.Free;
  end;
end;
{$ENDIF}

{-------------------------------------------------------------------------------
  过程名:    GetCurrPath
  作者:      马敏钊
  日期:      2006.01.09
  参数:      无
  返回值:    String
  说明:      获取当前项目的路径
-------------------------------------------------------------------------------}

function GetCurrPath: string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

{--------------------------------
  过程名:    IsallNumber
  作者:      mmz
  日期:      2006.01.06
  参数:      IStr: string
  返回值:    boolean
  说明:
-------------------------------------------------------------------------------}

function IsallNumber(IStr: string): boolean;
var
  i: Integer;
begin
  if Length(IStr) = 0 then begin
    Result := False;
    Exit;
  end;
  Result := True;
  for I := 1 to Length(IStr) do begin // Iterate
    if not (IStr[i] in ['0'..'9']) then begin
      Result := False;
      Exit;
    end;
  end; // for
end;

{-------------------------------------------------------------------------------
  过程名:    GetDateTime
  作者:      马敏钊
  日期:      2006.01.15
  参数:      无
  返回值:    String
  说明:      获取格式化的时间
-------------------------------------------------------------------------------}

function GetFormatTime: string;
begin
  Result := FormatDateTime('hh:nn:ss', now);
end;

function GetDocTime: string;
begin
  Result := FormatDateTime('hhnnss', Time);
end;

function GetFormatDate: string;
begin
  Result := FormatDateTime('yyyy-mm-dd', Date);
end;

function GetDocDate: string;
begin
  Result := FormatDateTime('yyyymmdd', Date);
end;

function GetFormatDateTime: string;
begin
  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
end;

function SetSystime(ATime: TDateTime): boolean;
var
  ADateTime: TSystemTime;
  yy, mon, dd, hh, min, ss, ms: Word;
begin
  decodedate(ATime, yy, mon, dd);
  decodetime(ATime, hh, min, ss, ms);
  with ADateTime do begin
    wYear := yy;
    wMonth := mon;
    wDay := dd;
    wHour := hh;
    wMinute := min;
    wSecond := ss;
    wMilliseconds := ms;
  end;
  Result := SetLocalTime(ADateTime);
 // PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
end;


{-------------------------------------------------------------------------------
  过程名:    AppRunOnce
  作者:      马敏钊
  日期:      2006.02.28
  参数:      无