BaseFunction.pas

{**********************************************
***  Name: BaseFunction;
***  Author: SilverLong 2005-8-15;
***
***  Function: 公共函数；
**********************************************}

unit BaseFunction;

interface
USES windows,SysUtils,Classes,Controls,dbtables, Dialogs,DB,FORMS,ComCtrls,
  Math ,ShlObj, ActiveX, ComObj, Registry,XMLDoc, XMLIntf,  strutils,
  Messages,  Variants, Graphics,ExtCtrls, StdCtrls,ImgList, Grids, DBGrids;
  //System;

//***************************************************//
type
{ TStream seek origins }
  TFolderNo = (Desktop, StartMenu, Programs);

type

 TCPUID = array[1..4] of Longint;
 TVendor = array [0..11] of char;

  TObjList=class (TList)
  public
    destructor Destroy; override;
    procedure Clear; override;
    procedure SaveToStream(stream: TStream); virtual;
    procedure LoadFromStream(stream: TStream); virtual;
  end;

var
  _DecNum: Integer;

  _RoundValue: Double;

  _EquMinValue: Double;

  _ZeroMinValue: Double; 

function StrIsEmpty (s: String): Boolean;

//procedure StringWrite (F : File; s: String);

//procedure StringRead (F : File; s: String);

function SLtrim (s: String): String;

function STrim (s: String): String;

function SAllTrim (s: String): String;

function SRemoveSpace (s: String): String;//除掉空格

procedure SSplitString (s: String; s1: String; s2: String);

procedure SSplitString1 (s: String; s1: String; s2: String);

function SIntToStrFix (n: Integer; cnt: Integer): String;

function ARound (v: Double): Double;   //求整

function ARoundN (v: Double; n: Integer): Double;  //保留几位小数

function AEqu (v1: Double; v2: Double): Boolean;    //两个是否相等

function ASmall (v1: Double; v2: Double): Boolean;  //file://v1 < v2

function ABig (v1: Double; v2: Double): Boolean;   // file://v1 > v2

function AIsZero (v1: Double): Boolean;  //file://判断是否为零

function AMax (a: Double; b: Double): Double; // file://返回大值

function AMin (a: Double; b: Double): Double; // file://返回小值

procedure ASwap (p1: Double; p2: Double); // file://交换

function IMax (a: Integer; b: Integer): Integer; //file://返回大值

function IMin (a: Integer; b: Integer): Integer;// file://返回小值

procedure ISwap (p1: Integer; p2: Integer);  //file://交换

function RealToStr (v: Double): String;   //file://Double转换成String

function RealToStr1 (v: Double): String;

function StrToReal (s: String): Double;  //file://String转换成Double

function RealStr (v: Double): String;    //file://Double转换成String

function RealStrN (v: Double; dec: Integer): String;  //file://保留几位小数 Double转换成String

function RealDateN(v: Double): String;  //file://日期转化成字符

function IsDate(const str: string): Boolean;

function GetDate(const str: string): TDateTime;  //file://字符转化成日期

function RealStr1 (v: Double; len: Integer; dec: Integer): String;

function RealStr2 (v: Double; len: Integer; dec: Integer): String;

function RealStr3 (v: Double; len: Integer; dec: Integer): String;

function RealStr4 (v: Double; len: Integer; dec: Integer): String;

function StrInt (s: String): Integer;   //file://string 转换成 integer

//file://xml
procedure WriteXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);

procedure ReadXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);

//file://以下是保存为数据流
procedure WriteToStream (stream: TStream; const Number: Integer); overload;

procedure WriteToStream (stream: TStream; const Number: Int64); overload;

procedure WriteToStream (stream: TStream; const v: Cardinal); overload;

procedure WriteToStream (stream: TStream; const v: Word); overload;

procedure WriteToStream (stream: TStream; const Filestr: String); overload;

procedure WriteToStream (stream: TStream; const v: Double); overload;

procedure WriteToStream (stream: TStream; const Bool: Boolean); overload;

procedure ReadFromStream (stream: TStream; var v: Cardinal); overload;

procedure WriteToStream (stream: TStream; const Number: Extended); overload;

procedure ReadFromStream (stream: TStream; var v: Extended); overload;

procedure ReadFromStream (stream: TStream; var Number: Integer); overload;

procedure ReadFromStream (stream: TStream; var Number: Int64); overload;

procedure ReadFromStream (stream: TStream; var v: Word); overload;

procedure ReadFromStream (stream: TStream; var Filestr: String); overload;

procedure ReadFromStream (stream: TStream; var v: Double); overload;

procedure ReadFromStream (stream: TStream; var Bool: Boolean); overload;

procedure WriteToStream (stream: TStream; const sList: TStringList); overload;

procedure ReadFromStream (stream: TStream; var sList: TStringList); overload;

procedure WriteToStream (stream: TStream; const iary: array of Integer); overload;

procedure ReadFromStream (stream: TStream; var iary: array of Integer); overload;

function StrLike (sou: String; key: String): Boolean;  //file://sou中是否包括key

function SRight (s: String; n: Integer): String;     // file://取右边多少个字符

procedure LoadFileList (Path: String; slist: TStrings; noPath: Boolean);

function TimeTicket: Longint;

function MonthOfDate (date: TDateTime): Integer;

function DayOfDate (date: TDateTime): Integer;

function YearOfDate (date: TDateTime): Integer;

function GetSplitWord (s: String; splitc: Char): String;

function HexToInt (s: String): Integer; //file://16进制转换成10进制

function TransStrByTable (sou: String; ori: TStringList; des: TStringList): String;

procedure LoadTransTable (fn: String; sou: TStringList; tag: TStringList);

function MakeFilePath (s: String): String;

function RemoveNote (s: String): String;

function MakePath (path: String): String;

function Blone (tj: String; v: String): Boolean;

function CodeStr (s: String): String;

function DeCodeStr (s: String): String;

function GetValueFromStr (vname: String; s: String; txt: String): Boolean;

function GetParaList (txt: String; ss: TStringList): Boolean;

function SReplace (txt: String; sou: String; tag: String): String;

Function GetOSInfo: String;    // file://NT 还是 Windows 98?取得当前操作平台

function GetCurrentUserName : string;// file://获取当前Windows用户的登录名

Procedure SetLink(FolderNo: TFolderNo; ACmdFile, Parameter, LinkName: string);//创建快捷方式

function GetMouseHwndAndClassName(Sender: TObject): string;

function GetMousePosHwndAndClassName(Sender: TPoint): string; //file://获取当前鼠标位置的类名和句柄

function GetIdeDiskSerialNumber : String;  //file://取Ide硬盘序列号函数

//file://得到CpuID号
function GetCPUID : TCPUID; assembler; register;

function GetCPUVendor : TVendor; assembler; register;

function GetCPUIDStr: String;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField; var Text: String);

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField; const Text: String):Boolean;

//file://不能输入字符
function CheckNullValue(var Key: Char): Boolean;

{判断输入的字符是否是数字}
function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;

//file://得到下一编号
function  GetNextStrId(const PreId: string): string;   // preId := 'LX000000';

//***************************************************//

//数据表复制（将源S_DATASET数据复制到目标D_DATASET)
PROCEDURE DB_CLONE(S_DATASET,D_DATASET:TDATASET);

//数据保存事物处理-单表 参数（保存QUERY，处理 DATABASE）
PROCEDURE BC_SWCL(CQY_CLQY:TQUERY;CDB_CLDB:TDATABASE);//处理事务

//数据集中单列数据求和  参数 （CDA_CLDA:合计数据集;CS_ZDM:合计列的字段名;VAR CI_SL:返回记录数）返回单列合计
FUNCTION HJ_SL_DL(CDA_CLDA:TDataSet;CS_ZDM:STRING;VAR CI_SL:INTEGER):REAL;

//数据集中单列数据求和  参数 （CDA_CLDA:合计数据集;CS_ZDM:合计列的字段名）返回单列合计
FUNCTION HJ_DL(CDA_CLDA:TDataSet;CS_ZDM:STRING):REAL;

//数据LOOKUP字段模拟 参数 CQY_CXQY 主QY,CQY_GGQY:外键代码QY ; CS_CXZDM 查询字段名,CS_CXSJ 查询数据,CS_XSZDM 显示代码QY字段名,CS_GGZDM,CS_WCDXSXX:STRING;  VAR RS_XSSJ:STRING;CS_XGBZ:BOOLEAN):BOOLEAN;
FUNCTION LOOKUP(CQY_CXQY,CQY_GGQY:TQUERY;
         CS_CXZDM,CS_CXSJ,CS_XSZDM,CS_GGZDM,CS_WCDXSXX:STRING;
         VAR RS_XSSJ:STRING;CS_XGBZ:BOOLEAN):BOOLEAN;

//数据写入
FUNCTION ZXXR(CDT_GGDT:TDATASET;CS_SZZDM,CS_SZSJ:Variant):BOOLEAN;

//删除数据集中所有数据 参数（CDA_CLDA 需删除的数据集）
PROCEDURE SC_QY(CDA_CLDA:TDataSet);

//在数据集中定位  参数 DATASET  定位数据集;CS_ZDM 定位字段 CS_CS:定位值 如果定位到返回TRUE 否则返回FALSE
//注意要求全匹配定位
FUNCTION LOCATE1(DATASET:TDATASET;CS_ZDM,CS_CS: STRING):BOOLEAN;

//在数据集中定位  参数 DATASET  定位数据集;CS_ZDM1 定位字段1 ;CS_ZDM1 定位字段2；CS_CS1:定位值1 CS_CS2:定位值2；如果定位到返回TRUE 否则返回FALSE
//注意要求全匹配定位
FUNCTION LOCATE2(DATASET:TDATASET;CS_ZDM1,CS_ZDM2,CS_CS1,CS_CS2: STRING):BOOLEAN;

//删除数据集中所有数据 参数（CDA_CLDA 需删除的数据集）
procedure SCDB(DATASET: TDATASET);

//两查询数据集事物保存 F_QUERY 数据集1, S_QUERY:数据集1 TQUERY;CDB_CLDB:TDATABASE);
procedure BC_LX(F_QUERY, S_QUERY: TQUERY;CDB_CLDB:TDATABASE);

//三查询数据集事物保存 F_QUERY 数据集1, S_QUERY:数据集1 TQUERY;CDB_CLDB:TDATABASE);
procedure BC_SX(F_QUERY, S_QUERY ,T_QUERY: TQUERY;CDB_CLDB:TDATABASE);

//四查询数据集事物保存 F_QUERY 数据集1, S_QUERY:数据集1 TQUERY;CDB_CLDB:TDATABASE);
procedure BC_SHX(F_QUERY, S_QUERY ,T_QUERY,TH_QUERY: TQUERY;CDB_CLDB:TDATABASE);

//定位
Function LOCATE3( const cTable: TDATASET;const zdm,sValue: String): Boolean;

//***************************************************// 

//在字符串左、右根据输入的参数进行长度补位
FUNCTION AppendSpaceOfStr(SOURCES:STRING;nLen:INTEGER;nType:String;ReplaceStr:String):STRING;

//在整数左、右根据输入的参数进行长度补位
FUNCTION AppendSpaceOfInt(SOURCES:INTEGER;nLen:INTEGER;nType:String;ReplaceStr:String):STRING;

//取SOURCES字符串的右WS位
FUNCTION WS_RIGHT(SOURCES :STRING;WS:SHORTINT):STRING;

//将CS_SCC删除串 的' '清空
PROCEDURE QK_SCKK(VAR CS_SCC:STRING);

//取SOURCES字符串的左WS位
FUNCTION WS_LEFT(SOURCES :STRING;WS:SHORTINT):STRING;//取SOURCES的左WS位

//在目标串SOU中查找FGF分格符并将分格符前的串赋予DES返回
//PROCEDURE JQZFC(FGF:STRING;VAR SOU,DES:STRING);
//返回定长字符串  参数 CD 返回串长度 ZFC 格式的字符串 ；HJ 为TRUE填充空格在后  HJ 为FALSE填充空格在前
FUNCTION FHDCZFC(CD:SHORTINT;ZFC:STRING;HJ:BOOLEAN):STRING;

//***************************************************//
//***************************大小写转换**********************//
//************************************************
//此单位共定义两个函数来实现数字金额的中文大写转化
//此函数可支持12位整数
//程序思路如下************************************
//将小数点前的整数取出，算出整数长度，不足千亿时前面补足0！
//角分分别求出并保存！
//将12位的整数分割成3部分，高位代表亿，中间的代表万，剩下的代表千圆及一下
//分割成的三部分都有相同的长度，每位各代表千位、百位、拾位、个位
//定义genge函数，将计算这四位的数
//将3部分分别计算出来，合成，这里就是整数位的大写形式
//计算出分角形式
//合成，做尾后处理，输出返回

//程序作者 龙堂海  [e-mail]
//*************************************************

//**************************************************/
//*****关键词:调用CHM 帮助文件                     */
//*****在DELPHI中如何调用CHM格式的帮助文件。       */
//*****最重要的是实现调用时要打开对应的帮助主题,   */
//*****也就是要跳到指定的索引。                    */
//*****然后,在调用时如下所示:                      */
//*****HtmlHelpA(Handle 'c:/windows/myHelp.chm' 0 '欢迎.htm');
//*****定义一个函数:

{ 例子
  try
    strtofloat(labelededit1.Text);
    labelededit2.Text:=xiaotoda(labelededit1.Text);
  except
    messagebox(handle,'输入的数字有错误！','错误',mb_ok+mb_iconwarning);
    labelededit1.SelectAll;
    labelededit1.SetFocus;
  end;

  }

const
     da:array[0..9]of pchar=('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
     C1 = 52845; //常量
     C2 = 22719; //常量
     TableName = 'LOTTERY_';

function xiaotoda(money:string):string; //主函数
function fenge(p:string):string; //计算4位数字的千位、百位、拾位、个位，这具有普遍性！

function HtmlHelpA (hwndcaller:Longint;lpHelpfile:string;wCommand:Longint;dwData:string):HWND;STDCALL;EXTERNAL 'hhctrl.ocx';
function Encrypt(const S: String; Key: Word): String;//字符串加密
function Decrypt(const S: String; Key: Word): String;//字符串解密
procedure EncryptFile(INFName, OutFName : String; Key : Word);//文件加密
procedure DecryptFile(INFName, OutFName : String; Key : Word);//文件解密

//处理读取文件内容
Function GetFileText(Filename,ReamName,FilePath:String):TStringList;
//处理网络资源的永久连接
Function Connettion(FileListName,ServerIP,UserName,UserPWD:String):integer;
//判断是否为数字
function IsNum(str:string):boolean;
//取字串的右边若干字元
function RightStr(const sAString: string; iCount: integer): string;
// 取字串的左边若干字元
function LeftStr(const sAString: string; const iCount: integer):string;
 

//***************************大小写转换**********************//

//****************************Unicode转换************************//

type
  TPDUFormatRec = Record
    CenterLen:Array[0..1] of Char;                 //短信息中心地址长度
    CenterType:Array[0..1] of Char;                //短信息中心号码类型，91是TON/NPI
    CenterNumber:Array[0..13] of Char;             //所在地GSM短信息中心的号码
    FileHeader:Array[0..1] of Char;                //指正常地发送短信息
    SMType:Array[0..1] of Char;                    //信息类型
    CalledLen:Array[0..1] of Char;                 //被叫号码长度
    CalledType:Array[0..1] of Char;                //被叫号码类型
    CalledNumber:Array[0..11] of Char;             //被叫号码
//    PID:Array[0..1] of Char;                       //
//    DCS:Array[0..1] of Char;                       //
//    TimeStamp:Array[0..13] of Char;                //
    SMCodeType:Array[0..5] of Char;                //短信息编码类型GSM Default Alphabet，如为中文则是000010
    SMLen:Array[0..1] of Char;                     //短信息长度
  end;

  TPDUSendRec = Record
    SMSCLength:Array[0..1] of Char;
    FirstOctet:Array[0..1] of Char;
    MessageReference:Array[0..1] of Char;
    PhoneLength:Array[0..1] of Char;
    AddressType:Array[0..1] of Char;
    Phone:Array[0..11] of Char;
    TPPID:Array[0..1] of Char;
    TPDCS:Array[0..1] of Char;
    TPValidityPeriod:Array[0..1] of Char;
    TPUserDataLength:Array[0..1] of Char;
    //TPUserData
  end;

  TPDUFirstReadRec = Record
    SMSCLength:Array[0..1] of Char;
    AddressType:Array[0..1] of Char;
    ServiceCenterNumber:Array[0..13] of Char;       //Length???
    FirstOctet:Array[0..1] of Char;

    SendPhoneLength:Array[0..1] of Char;
    SendPhoneType:Array[0..1] of Char;
//    TONNPI:Array[0..1] of Char;
    //Phone
  end;

  TPDUSecondReadRec = Record
    TPPID:Array[0..1] of Char;
    TPDCS:Array[0..1] of Char;
    TimeStamp:Array[0..13] of Char;
    TPUserDataLength:Array[0..1] of Char;
    //TPUserData
  end;

  function ChangeOrder(OriStr:String;TotalLen:Integer):String;
  function ResumeOrder(OriStr:String):String;

  function EncodeEnglish(s:String):String;
  function DecodeEnglish(s:String):String;

  function Encode8Bits(s:String):String;
  function Decode8Bits(s:String):String;

  function EncodeUniCode(s:WideString):String;
  function DecodeUniCode(s:String):WideString;

  Function Mix2PDU(CenterNumber,CalledNumber,ShortMsg:String):String;
  function MixSendPDU(Phone,ShortMsg:String;Var SendLen:String;SMType:Integer):String;
  function DisposeReadPDU(PDUData:String;Var Phone,MsgContent:String):Integer;

//****************************Unicode转换************************//

//***************************************************************//

//===============================================================
//动态定位数据行
//过程名：  DyDbgDataLine

//作者：    haitian

//日期：    2003-02-22

//功能：    根据用户指定的条件自动移动到DBGrid控件中符合此条件的某行数据上

//输入参数：

//          sValue：当前需要移动到的行的值；

//          tab：当前DBGrid中对应的表的数据；

//          dsr：当前需要操作的数据源；

//返回值：  无

//修改记录：

//================================================================
Procedure DyDbgDataLine(sValue:string;tab:Ttable;dsr:TDatasource);

//改变颜色标记当前数据行

//首先把DBGrid的DefaultDrawing属性设为false;然后在OnDrawDataCell事件函数中调用下面的函数：

//===============================================================

//过程名：  DrawLine

//作者：    haitian

//日期：    2003-02-22

//功能：    把Dbgrid中的指定的行改变颜色作为标记；

//输入参数：

//          zdm：字段名；

//          Rect：需要出入的行的某个单元；

//          Field：当前显示的域；

//          state：当前行的显示状态；

//          zdz：当前需要移动到的行的值；

//          tab：当前DBGrid中对应的表的数据；

//          dbg：当前需要操作的DBGrid；

//返回值：  无

//修改记录：

//================================================================
Procedure DrawLine(tab:Ttable;const Rect:Trect;Field:Tfield;state:TgridDrawState;dbg:TDBGrid);

//四舍五入的函数，具体用法　myround(1.999,2) = 2.00
//第一位1.999为要四舍五入的数，2为要取的小数位
//yuan:原浮点数，PP保留 小数点后第几位
function myround(const yuan: Extended; const pp: Integer): Extended;

//***************************************************************//

//功  能:得到汉字笔画
function GetBiHua(chnstr:string):integer;

implementation

//file://得到下一编号
function  GetNextStrId(const PreId: string): string;   // preId := 'LX000000';
var
  I,n,n1:   Integer;
  s,s1:  string;
  c:     char;
begin
  n := Length(PreId);
  n1 := 0;
  for I := n downto 1 do begin
    c := PreId[I];
    if  (Ord(c) >= 65) and (Ord(c) <= 90) then begin
       n1 := I;
       Break;
    end;
  end;
  s := Copy(PreId, 1, n1);
  s1 := Copy(PreId, n1 + 1, 100);
  s1 := IntToStr(StrToInt(s1) + 1);
  result := s1;
  for I := 1 to  n - n1 - Length(s1) do
    Result := '0' + Result;
  result := s + Result;
end;

//file://不能输入字符
function CheckNullValue(var Key: Char): Boolean;
const
  ControlKeySet = [Char(#13)];
begin
  Key := #0;
  Result := True;
end;

{判断输入的字符是否是数字}
function CheckInputNum(const IsInteger: Boolean; AStr: string; var Key: Char): Boolean;
const
  NumberSet = ['0' .. '9', '.', '-'];
  ControlKeySet = [Char(#8), Char(#13)];
begin
  if Key in ControlKeySet then begin
    Result := True;
    Exit;
  end;

  if not (Key in NumberSet) then Key := #0;
  if (Key = '.') and ((Length(AStr) = 0) or (Pos('.', AStr) > 0)) then
    Key := #0;

  //file://不能前两个同时为0
  if (Length(AStr) = 1) and (AStr[1] = '0') and (Key = '0') then Key := #0;

  //file://不能有多个负号
  if (Pos('-', AStr) >= 0) and (Key = '-') then Key := #0;

  if IsInteger then begin
    if key = '.' then Key := #0;
//    if (Length(AStr) = 1) and (AStr[1] = '0') or (Key = '.') then Key := #0;
  end;
  Result := Key <> #0;
end;

{日期型字段显示过程,在OnGetText事件中调用}
procedure DateFieldGetText(Sender: TField; var Text: String);
var
  dDate: TDate;
  wYear,wMonth,wDay: Word;
  aryTestYMD: Array [1..2] of Char ;{测试输入掩码用临时数组}
  iYMD: Integer;
begin
  iYMD := 0;
  dDate:= Sender.AsDateTime;
  DecodeDate(dDate,wYear,wMonth,wDay);
  {测试输入掩码所包含的格式.}
  aryTestYMD:= '年';
  if StrScan(PChar(Sender.EditMask), aryTestYMD[1]) <> nil then iYMD:= 1;
  aryTestYMD:= '月';
  if StrScan(PChar(Sender.EditMask), aryTestYMD[1]) <> nil then iYMD:= 2;
  aryTestYMD:= '日';
  if StrScan(PChar(Sender.EditMask), aryTestYMD[1]) <> nil then iYMD:= 3;
  case iYMD of
    1:{输入掩码为:”yyyy年”的格式.}
    Text:= IntToStr(wYear) + '年';
    2: {输入掩码为:”yyyy年mm月”的格式.}
    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月';
    3: {输入掩码为:”yyyy年mm月dd日”的格式.}
    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月' + IntToStr(wDay) + '日';
    else {默认为:”yyyy年mm月dd日”的格式.}
    Text:= IntToStr(wYear) + '年' + IntToStr(wMonth) + '月' + IntToStr(wDay) + '日';
  end;
end;

{日期型字段输入判断函数,在OnSetText事件中调用}
function DateFieldSetText(Sender: TField; const Text: String):Boolean;
var
  dDate: TDate;
  sYear,sMonth,sDay: String;
  aryTestYMD: Array [1..2] of Char;
  iYMD: Integer;
begin
  iYMD := 0;
{获得用户输入的日期}
  sYear := Copy(Text, 1, 4);
  sMonth:= Copy(Text, 7, 2);
  SDay  := Copy(Text, 11, 2);
{测试输入掩码所包含的格式.}
  aryTestYMD := '年';
  if StrScan( PChar(Sender.EditMask), aryTestYMD[1] ) <> nil then iYMD := 1;
  aryTestYMD := '月';
  if StrScan( PChar(Sender.EditMask), aryTestYMD[1] ) <> nil then iYMD := 2;
  aryTestYMD := '日';
  if StrScan( PChar(Sender.EditMask), aryTestYMD[1] ) <> nil then iYMD := 3;
  {利用Try…Except进行输入的日期转换}
  try begin
    case iYMD of
      1: {输入掩码为:”yyyy年”的格式.}
        begin
        dDate := StrToDate( sYear + '-01-01' );{中文Windows默认的日期格式为:yyyy-mm-dd.下同}
        Sender.AsDateTime := dDate;
        end;
      2: {输入掩码为:”yyyy年mm月”的格式.}
        begin
        dDate := StrToDate( sYear + '-' + sMonth + '-01' );
        Sender.AsDateTime:=dDate;
        end;
      3: {输入掩码为:”yyyy年mm月dd日”的格式.}
        begin
        dDate := StrToDate( sYear + '-' + sMonth + '-' + sDay );
        Sender.AsDateTime := dDate;
        end;
      else {默认为:”yyyy年mm月dd日”的格式.}
        begin
        dDate := StrToDate( sYear + '-' + sMonth + '-' + sDay );
        Sender.AsDateTime := dDate;
        end;
    end;
    DateFieldSetText := True;
  end;
  except
    {日期转换出错}
    begin
      showmessage( PChar ( Text + '不是有效的日期!'));
      DateFieldSetText := False;
    end;
end;

end;

function GetMouseHwndAndClassName(Sender: TObject): string;
var
rPos: TPoint;
begin
  Result := '';
  //if boolean(GetCursorPos(rPos)) then Result := GetMousePosHwndAndClassName(rPos);
end;

function GetMousePosHwndAndClassName(Sender: TPoint): string;
var
  hWnd: THandle;
  aName: array [0..255] of char;
  tmpstr: string;
begin
  tmpstr := '';
  hWnd := WindowFromPoint(Sender);
  tmpstr := 'Handle : ' + IntToStr(hWnd);

  if boolean(GetClassName(hWnd, aName, 256)) then
    tmpstr := 'ClassName : ' + string(aName)
  else
    tmpstr := 'ClassName : not found';
  Result := tmpstr; 
end;

function GetCurrentUserName : string;
const
  cnMaxUserNameLen = 254;
var
  sUserName : string;
  dwUserNameLen : Dword;
begin
  dwUserNameLen := cnMaxUserNameLen-1;
  SetLength( sUserName, cnMaxUserNameLen );
  GetUserName(Pchar( sUserName ), dwUserNameLen );
  SetLength( sUserName, dwUserNameLen );
  Result := sUserName;
end;

Procedure SetLink(FolderNo: TFolderNo; ACmdFile, Parameter, LinkName: string);
var
  MyObject : Iunknown;
  MySLink : IShellLink;
  MyPFile : IPersistFile;
  FileName : string;
  Directory : string;
  WFileName : WideString;
  MyReg : TRegIniFile;
  tmpFolderNo : string;
begin
  if FolderNo = Desktop then tmpFolderNo:= 'Desktop';
  if FolderNo = StartMenu then tmpFolderNo:= 'StartMenu';
  if FolderNo = Programs then tmpFolderNo:= 'Programs';
   
  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;
  FileName := ACmdFile;
  with MySLink do
  begin
    SetArguments(Pchar(Parameter));
    SetPath(Pchar(FileName));
    SetWorkingDirectory(Pchar(ExtractFilePath(FileName)));
  end;
  MyReg := TRegIniFile.Create('Software/MicroSoft/Windows/CurrentVersion/Explorer');

  Directory := MyReg.ReadString('Shell Folders', tmpFolderNo,'');
  //file://CreateDir(Directory);
  WFileName := Directory + '/' + LinkName + '.lnk';
  MyPFile.Save(PWChar(WFileName),False);
  MyReg.Free;
end;

Function GetOSInfo: String;
var
  VI: TOSVersionInfo;
begin
  Result:= '';
  VI.dwOSVersionInfoSize := SizeOf(VI);
  GetVersionEx(VI);//取得正在运行的Windeows和Win32操作系统的版本

//  VI.dwPlatformId
  Result:= Result + Format('%d%d%d',[VI.dwMajorVersion,VI.dwMinorVersion,VI.dwBuildNumber]);
  //Result:= Result + GetIdeDiskSerialNumber + GetCPUIDStr;
  case Win32Platform of
    VER_PLATFORM_WIN32_WINDOWS: Result := Result + 'Windows 95/98';
    VER_PLATFORM_WIN32_NT: Result := Result + 'Windows NT';
  else
    Result := Result + 'Windows32';
  end;
end;

function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD             {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI     {Restore registers}
  POP     EBX
end;

function GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX     {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX   {@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F    {CPUID Command}
  MOV     EAX,EBX
  XCHG  EBX,ECX     {save ECX result}
  MOV   ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV   ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV   ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI     {Restore registers}
  POP     EBX
end;

function GetCPUIDStr: String;
var
  CPUID : TCPUID;
  I     : Integer;
  S   : TVendor;
begin
  Result := '';
 for I := Low(CPUID) to High(CPUID)  do CPUID[I] := -1;
    CPUID := GetCPUID;
  Result := Result + IntToHex(CPUID[1],8);
  Result := Result + IntToHex(CPUID[2],8);
  Result := Result + IntToHex(CPUID[3],8);
  Result := Result + IntToHex(CPUID[4],8);
  S := GetCPUVendor;
  Result := Result + S;
end;

function GetIdeDiskSerialNumber : String;  //file://取Ide硬盘序列号函数
  type
    TSrbIoControl = packed record
    HeaderLength : ULONG;
    Signature : Array[0..7] of Char;
    Timeout : ULONG;
    ControlCode : ULONG;
    ReturnCode : ULONG;
    Length : ULONG;
  end;
  SRB_IO_CONTROL = TSrbIoControl;
  PSrbIoControl = ^TSrbIoControl;

  TIDERegs = packed record
    bFeaturesReg : Byte; // Used for specifying SMART "commands".
    bSectorCountReg : Byte; // IDE sector count register
    bSectorNumberReg : Byte; // IDE sector number register
    bCylLowReg : Byte; // IDE low order cylinder value
    bCylHighReg : Byte; // IDE high order cylinder value
    bDriveHeadReg : Byte; // IDE drive/head register
    bCommandReg : Byte; // Actual IDE command.
    bReserved : Byte; // reserved. Must be zero.
  end;
  IDEREGS = TIDERegs;
  PIDERegs = ^TIDERegs;

  TSendCmdInParams = packed record
    cBufferSize : DWORD;
    irDriveRegs : TIDERegs;
    bDriveNumber : Byte;
    bReserved : Array[0..2] of Byte;
    dwReserved : Array[0..3] of DWORD;
    bBuffer : Array[0..0] of Byte;
  end;
  SENDCMDINPARAMS = TSendCmdInParams;
  PSendCmdInParams = ^TSendCmdInParams;

  TIdSector = packed record
    wGenConfig : Word;
    wNumCyls : Word;
    wReserved : Word;
    wNumHeads : Word;
    wBytesPerTrack : Word;
    wBytesPerSector : Word;
    wSectorsPerTrack : Word;
    wVendorUnique : Array[0..2] of Word;
    sSerialNumber : Array[0..19] of Char;
    wBufferType : Word;
    wBufferSize : Word;
    wECCSize : Word;
    sFirmwareRev : Array[0..7] of Char;
    sModelNumber : Array[0..39] of Char;
    wMoreVendorUnique : Word;
    wDoubleWordIO : Word;
    wCapabilities : Word;
    wReserved1 : Word;
    wPIOTiming : Word;
    wDMATiming : Word;
    wBS : Word;
    wNumCurrentCyls : Word;
    wNumCurrentHeads : Word;
    wNumCurrentSectorsPerTrack : Word;
    ulCurrentSectorCapacity : ULONG;
    wMultSectorStuff : Word;
    ulTotalAddressableSectors : ULONG;
    wSingleWordDMA : Word;
    wMultiWordDMA : Word;
    bReserved : Array[0..127] of Byte;
  end;
  PIdSector = ^TIdSector;

const
  IDE_ID_FUNCTION = $EC;
  IDENTIFY_BUFFER_SIZE = 512;
  DFP_RECEIVE_DRIVE_DATA = $0007c088;
  IOCTL_SCSI_MINIPORT = $0004d008;
  IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
  DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
  BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
  W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;

var
  hDevice : THandle;
  cbBytesReturned : DWORD;
  pInData : PSendCmdInParams;
  pOutData : Pointer; // PSendCmdOutParams
  Buffer : Array[0..BufferSize-1] of Byte;
  srbControl : TSrbIoControl absolute Buffer;

  procedure ChangeByteOrder( var Data; Size : Integer );
  var
    ptr : PChar;
    i : Integer;
    c : Char;
  begin
    ptr := @Data;
    for i := 0 to (Size shr 1)-1 do begin
      c := ptr^;
      ptr^ := (ptr+1)^;
      (ptr+1)^ := c;
      Inc(ptr,2);
     end;
  end;

begin
  Result := '';
  FillChar(Buffer,BufferSize,#0);
  if Win32Platform=VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000
// Get SCSI port handle
    hDevice := CreateFile( '//./Scsi0:',GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE,
                          nil, OPEN_EXISTING, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
      System.Move('SCSIDISK',srbControl.Signature,8);
      srbControl.Timeout := 2;
      srbControl.Length := DataSize;
      srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
      pInData := PSendCmdInParams(PChar(@Buffer) + SizeOf(SRB_IO_CONTROL));
      pOutData := pInData;
      with pInData^ do begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
      @Buffer, BufferSize, @Buffer, BufferSize,
      cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
  end else begin // Windows 95 OSR2, Windows 98
    hDevice := CreateFile( '//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
    if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
      pInData := PSendCmdInParams(@Buffer);
      pOutData := @pInData^.bBuffer;
      with pInData^ do begin
        cBufferSize := IDENTIFY_BUFFER_SIZE;
        bDriveNumber := 0;
        with irDriveRegs do begin
          bFeaturesReg := 0;
          bSectorCountReg := 1;
          bSectorNumberReg := 1;
          bCylLowReg := 0;
          bCylHighReg := 0;
          bDriveHeadReg := $A0;
          bCommandReg := IDE_ID_FUNCTION;
        end;
      end;
      if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
            pInData, SizeOf(TSendCmdInParams)-1, pOutData,
            W9xBufferSize, cbBytesReturned, nil ) then Exit;
    finally
      CloseHandle(hDevice);
    end;
  end;
  with PIdSector(PChar(pOutData)+16)^ do begin
    ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
    SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
  end;
end;

procedure TObjList.Clear;
begin
  inherited;
end;

destructor TObjList.Destroy;
begin
  inherited;
end;

function StrIsEmpty (s: String): Boolean;
begin
  Result := False;
  if s = '' then
    Result := True;
end;

{procedure StringWrite (f: file; s: String);
begin
end;

procedure StringRead (f: file; s: String);
begin
end;
}
function SLtrim (s: String): String;
begin
end;

function STrim (s: String): String;
begin
end;

function SAllTrim (s: String): String;
begin
end;

function SRemoveSpace (s: String): String;
var
  I     : Integer;
  Count : Integer;
begin
  Result:= '';
  Count := length(s);
  for I := 1 to Count do begin
    if s[I] <> ' ' then begin
      Result  := Result + s[I];
    end;
  end;
end;

procedure SSplitString (s: String; s1: String; s2: String);
begin

end;

procedure SSplitString1 (s: String; s1: String; s2: String);
begin

end;

function SIntToStrFix (n: Integer; cnt: Integer): String;
begin
end;

function ARound (v: Double): Double;
begin
  Result := Round(V);
end;

function ARoundN (v: Double; n: Integer): Double;
var
  I   : Integer;
begin
  result := v;
  for I := 0 to N - 1 do begin
    Result := Result * 10;
  end;
  Result := Round(Result);
  for I := 0 to N - 1 do begin
    Result := Result / 10;
  end;
end;

function AEqu (v1: Double; v2: Double): Boolean;
begin
  result := False;
  if v1 = v2 then
    result := True
end;

function ASmall (v1: Double; v2: Double): Boolean;
begin
  result := False;
  if v1 < v2 then
    result := True;
end;

function ABig (v1: Double; v2: Double): Boolean;
begin
  result := False;
  if v1 > v2 then
    result := True;
end;

function AIsZero (v1: Double): Boolean;
begin
  Result := False;
  if V1 = 0 then Result := True;
end;

function AMax(a: Double; b: Double): Double;
begin
  if a >= b then
    result := a
  else
    result := b;
end;

function AMin(a: Double; b: Double): Double;
begin
  if a >= b then
    result := b
  else
    result := a;
end;

procedure ASwap (p1: Double; p2: Double);
begin

end;

function IMax(a: Integer; b: Integer): Integer;
begin
 if a >= b then
   result := a
 else
   result := b;
end;

function IMin(a: Integer; b: Integer): Integer;
begin
 if a >= b then
   result := b
 else
   result := a;
end;

procedure ISwap (p1: Integer; p2: Integer);
begin

end;

function RealToStr (v: Double): String;
begin
  result := FloatToStr(v);
end;

function RealToStr1 (v: Double): String;
begin
end;

function StrToReal(s: String): Double;
var
  I : Integer;
  B : Boolean;
begin
  B := True;
  result := 0;
  for I := 1 to length(s) do begin
    if (ord(s[I]) > 57) or (ord(s[I]) < 48) then begin
      if ord(s[I]) <> 46 then begin
        B := False;
        Break;
      end;
    end;
  end;

  if B and (Length(s) <> 0) then
    result := StrToFloat(s)
end;

function RealStr (v: Double): String;
begin
  result := FloatToStr(v);
end;

function FloatToFloat(Const D: Double; Const N: integer): Double;
var
  I   : integer;
  Max : LongInt;
begin
  Max := 1;
  for I := 1 to N do begin
    Max := Max * 10;
  end;
  result := D * Max;
  result := Round(result);
  result := result / Max;
end;

function RealStrN (v: Double; dec: Integer): String;
var
  TD : Double;
begin
  TD := FloatToFloat(V, dec);
  result := FloatToStr(TD);
end;

function RealDateN(v: Double): String;
var
  Year, Month, Day : word;
begin
  DecodeDate(v, Year, Month, Day);
  result := IntToStr(year) + '年' + IntToStr(Month) + '月' + IntToStr(Day) + '日';
end;

function IsDate(const str: string): Boolean;
begin
  try
    StrToDate(str);
  except
    Result := False;
    Exit;
  end;
  Result := True;
end;

function GetDate(const str: string): TDateTime;
var
  NewStr: string;
begin
  NewStr := str;
  NewStr := StringReplace(NewStr,'年','-',[]);
  NewStr := StringReplace(NewStr,'月','-',[]);
  NewStr := StringReplace(NewStr,'日','',[]);

  if IsDate(NewStr) then Result := StrToDate(NewStr)
  else Result := SysUtils.Date;
end;

function RealStr1 (v: Double; len: Integer; dec: Integer): String;
begin
 
end;

function RealStr2 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function RealStr3 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function RealStr4 (v: Double; len: Integer; dec: Integer): String;
begin
end;

function StrInt (s: String): Integer;
var
  I : Integer;
  B : Boolean;
begin
  B := True;
  result := 0;
  if s = '' then begin
    result := 0;
    Exit;
  end;
  for I := 1 to length(s) do begin
    if (ord(s[I]) > 57) or (ord(s[I]) < 48) then begin
      B := False;
      Break;
    end;
  end;

  if B and (Length(s) <> 0) then
    result := StrToInt(s)
end;

procedure WriteXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);
var
  Child_Node : IXMLNode;
begin
  Child_Node := XML.AddChild(mc);
  Child_Node.Text := Val;
end;

procedure ReadXMLValue(XML : IXMLNode; Const mc : string; Var Val: string);
var
  Child_Node : IXMLNode;
begin
  Child_Node := XML.ChildNodes.First;
  if (Child_Node.NodeName = mc) then
    Val := Child_Node.Text;
end;

procedure ReadFromStream(Stream: TStream; var Bool: Boolean);
begin
  Stream.Read(Bool,SizeOf(Bool));
end;

procedure ReadFromStream(Stream: TStream; var Number: integer);
begin
  Stream.Read(Number,SizeOf(Number));
end;

procedure ReadFromStream (stream: TStream; var Number: Int64); overload;
begin
  Stream.Read(Number,SizeOf(Number));
end;

procedure ReadFromStream(Stream: TStream; var Filestr: string);
var
  Count : integer;
  I : integer;
  S : Char;
begin
  Filestr := '';
  Count := 0;
  ReadFromStream(Stream, Count);
  for I := 1 to Count do begin
    Stream.Read(S, 1);
    Filestr:= Filestr + s;
  end;
end;

procedure WriteToStream(Stream: TStream; const Number: integer);
begin
  Stream.Write(Number,SizeOf(Number));
end;

procedure WriteToStream (stream: TStream; const Number: Int64); overload;
begin
  Stream.Write(Number,SizeOf(Number));
end;
//file://将filestr 写入流中
procedure WriteToStream(Stream: TStream; const Filestr: string);
var
  Count : integer;
  I : integer;
  S : Char;
begin
  Count:= length(Filestr);
  WriteToStream(Stream,Count);

  for I:= 1 to Count do begin
    S := FileStr[I];
    Stream.Write(S, 1);
  end;
end;

procedure WriteToStream (stream: TStream; const Number: Extended); overload;
begin
  Stream.Write(Number,SizeOf(Number));
end;

procedure ReadFromStream (stream: TStream; var v: Extended); overload;
begin
  Stream.Read(v,SizeOf(v)); 
end;

procedure WriteToStream(Stream: TStream; const Bool: Boolean);
begin
  Stream.Write(Bool,Sizeof(Bool));
end;

procedure WriteToStream (stream: TStream; const v: Cardinal); overload;
begin
end;

procedure WriteToStream (stream: TStream; const v: Word); overload;
begin
end;

procedure WriteToStream (stream: TStream; const v: Double); overload;
begin
  Stream.Write(V , sizeof(V));
end;

procedure ReadFromStream (stream: TStream; var v: Cardinal); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var v: Word); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var v: Double); overload;
begin
  Stream.Read(V , sizeof(v));
end;

procedure WriteToStream (stream: TStream; const sList: TStringList); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var sList: TStringList); overload;
begin
end;

procedure WriteToStream (stream: TStream; const iary: array of Integer); overload;
begin
end;

procedure ReadFromStream (stream: TStream; var iary: array of Integer); overload;
begin
end;

function StrLike (sou: String; key: String): Boolean;
begin
  result := False;
  if pos(sou, key) > 0 then
    result := True;
end;

function SRight (s: String; n: Integer): String;
var
  I   : Integer;
begin
  Result := '';
  for I := 1 to n do begin
    Result := Result + s[I];
  end;
end;

procedure LoadFileList (Path: String; slist: TStrings; noPath: Boolean);
begin

end;

function TimeTicket: Longint;
begin
  Result := 0;
end;

function MonthOfDate (date: TDateTime): Integer;
begin
  Result := 0;
end;

function DayOfDate (date: TDateTime): Integer;
begin
  Result := 0;
end;

function YearOfDate (date: TDateTime): Integer;
begin
  Result := 0;
end;

function GetSplitWord (s: String; splitc: Char): String;
begin
end;

function HexToInt (s: String): Integer;
begin
  Result := 0;
end;

function TransStrByTable (sou: String; ori: TStringList; des: TStringList): String;
begin
end;

procedure LoadTransTable (fn: String; sou: TStringList; tag: TStringList);
begin
end;

function MakeFilePath (s: String): String;
begin
end;

function RemoveNote (s: String): String;
begin
end;

function MakePath (path: String): String;
begin
end;

function Blone (tj: String; v: String): Boolean;
begin
  Result := False;
end;

function CodeStr (s: String): String;
begin
end;

function DeCodeStr (s: String): String;
begin
end;

function GetValueFromStr (vname: String; s: String; txt: String): Boolean;
begin
  Result := False;
end;

function GetParaList (txt: String; ss: TStringList): Boolean;
begin
  Result := False;
end;

function SReplace (txt: String; sou: String; tag: String): String;
begin
end;

procedure TObjList.LoadFromStream(stream: TStream);
var
  I : integer;
  tmpCount : integer;
  tmp: TObject; 
begin
  ReadFromStream(Stream, tmpCount);
  for I:= 0 to tmpCount - 1 do begin
    Stream.Read(tmp, SizeOf(tmp));
    Add(tmp);
  end;
end;

procedure TObjList.SaveToStream(stream: TStream);
var
  I : integer;
  tmp: TObject;
begin
  WriteToStream(Stream, Count);
  for I:= 0 to Count - 1 do begin
    tmp := Items[I];
    Stream.Write(tmp, Sizeof(tmp));
  end;
end;

//***************************************************//

//表克隆
PROCEDURE DB_CLONE(S_DATASET,D_DATASET:TDATASET);
VAR I:SHORTINT;
BEGIN
D_DATASET.Append;
WITH S_DATASET DO
     BEGIN
     FOR I:=0 TO FieldCount-1 DO
         BEGIN
         D_DATASET.Fields[I].VALUE:=Fields[I].VALUE;
         END;
     END;
D_DATASET.POST;
END;

//处理事务
PROCEDURE BC_SWCL(CQY_CLQY:TQUERY;CDB_CLDB:TDATABASE);
BEGIN
IF CQY_CLQY.State IN [DSEDIT,DSINSERT] THEN CQY_CLQY.Post;
IF CQY_CLQY.UpdatesPending THEN
BEGIN
     CDB_CLDB.StartTransaction;
         TRY
            CQY_CLQY.ApplyUpdates;
            CDB_CLDB.Commit;
         EXCEPT
            CDB_CLDB.Rollback;
            RAISE;
         END;
         CQY_CLQY.CommitUpdates;
END;
END;

//数据集中单列数据求和（返回记录数或返回单列合计）
FUNCTION HJ_SL_DL(CDA_CLDA:TDataSet;CS_ZDM:STRING;VAR CI_SL:INTEGER):REAL;
VAR LF_HJJG:REAL;
    L_DQJL: TBookmark;
BEGIN
LF_HJJG:=0;
L_DQJL:=CDA_CLDA.GETBOOKMARK;
IF CDA_CLDA.State IN [DSBROWSE]
   THEN BEGIN
        TRY
        WITH CDA_CLDA DO
             BEGIN
             FIRST;
             DisableControls;
             WHILE NOT EOF DO
                   BEGIN
                   LF_HJJG:=LF_HJJG+FIELDBYNAME(CS_ZDM).ASFLOAT;
                   CI_SL:=CI_SL+1;
                   NEXT;
                   END;
             EnableControls;
             END;
         FINALLY
         CDA_CLDA.GotoBookmark(L_DQJL);
         CDA_CLDA.FreeBookmark(L_DQJL);
         END;
         END;
RESULT:=LF_HJJG;
END;

//数据集中单列数据求和(返回单列合计)
FUNCTION HJ_DL(CDA_CLDA:TDataSet;CS_ZDM:STRING):REAL;
VAR LF_HJJG:REAL;
    L_DQJL: TBookmark;
BEGIN
LF_HJJG:=0;
L_DQJL:=CDA_CLDA.GETBOOKMARK;
IF CDA_CLDA.State IN [DSBROWSE]
   THEN BEGIN
        TRY
        WITH CDA_CLDA DO
             BEGIN
             FIRST;
             DisableControls;
             WHILE NOT EOF DO
                   BEGIN
                   LF_HJJG:=LF_HJJG+FIELDBYNAME(CS_ZDM).ASFLOAT;
                   NEXT;
                   END;
             EnableControls;
             END;
         FINALLY
         CDA_CLDA.GotoBookmark(L_DQJL);
         CDA_CLDA.FreeBookmark(L_DQJL);
         END;
         END;
RESULT:=LF_HJJG;
END;

//数据LOOKUP字段模拟
FUNCTION LOOKUP(CQY_CXQY,CQY_GGQY:TQUERY;
         CS_CXZDM,CS_CXSJ,CS_XSZDM,CS_GGZDM,CS_WCDXSXX:STRING;
         VAR RS_XSSJ:STRING;CS_XGBZ:BOOLEAN):BOOLEAN;
VAR LBL_ZD:BOOLEAN;
BEGIN
LBL_ZD:=FALSE;
IF CS_CXSJ=''
   THEN BEGIN
        RS_XSSJ:=CS_WCDXSXX;
{        RESULT:=LBL_ZD;}
        RESULT:=TRUE;
        IF CQY_GGQY.STATE IN [DSEDIT,DSINSERT]
           THEN BEGIN
                CQY_GGQY.EDIT;
                CQY_GGQY.FieldByName(CS_GGZDM).CLEAR;
                END;
        EXIT;
        END;
IF CQY_GGQY.ACTIVE THEN
WITH CQY_CXQY DO
     BEGIN
     CASE CQY_CXQY.FieldBYNAME(CS_CXZDM).DataType OF
          ftString: LBL_ZD:=LOCATE(CS_CXZDM,CS_CXSJ,[]);
          ftInteger,ftSmallint: LBL_ZD:=LOCATE(CS_CXZDM,STRTOINT(CS_CXSJ),[]);
     END;
     IF LBL_ZD
        THEN BEGIN
             IF CS_XGBZ AND (CQY_GGQY.FieldByName(CS_GGZDM).ASSTRING<>CS_CXSJ)
                THEN BEGIN
                     CQY_GGQY.EDIT;
                     CQY_GGQY.FieldByName(CS_GGZDM).ASSTRING:=CS_CXSJ;
                     END;
             RS_XSSJ:=CQY_CXQY.FIELDBYNAME(CS_XSZDM).ASSTRING;
             END
        ELSE BEGIN
             IF CS_XGBZ
                THEN BEGIN
                CQY_GGQY.EDIT;
                CQY_GGQY.FieldByName(CS_GGZDM).CLEAR;
                END;
             RS_XSSJ:=CS_WCDXSXX;
        END;
     END;
RESULT:=LBL_ZD;
END;

//数据写入
FUNCTION ZXXR(CDT_GGDT:TDATASET;CS_SZZDM,CS_SZSJ:Variant):BOOLEAN;
BEGIN
WITH CDT_GGDT DO
     BEGIN
     IF (ACTIVE) AND (CDT_GGDT AS TBDEDATASET).CachedUpdates
      THEN BEGIN
           EDIT;
           FIELDBYNAME(CS_SZZDM).VALUE:=CS_SZSJ;
           POST;
           RESULT:=TRUE;
           END
      ELSE RESULT:=FALSE;
     END;
END;

//删除数据集中所有数据
PROCEDURE SC_QY(CDA_CLDA:TDataSet);
BEGIN
WITH CDA_CLDA DO
    BEGIN
    FIRST;
         WHILE NOT EOF DO
               BEGIN
               DELETE;
               END;
    END;
END;

//在数据集中定位
FUNCTION LOCATE1(DATASET:TDATASET;CS_ZDM,CS_CS: STRING):BOOLEAN;
BEGIN
IF DATASET.ACTIVE
   THEN RESULT:=DATASET.Locate(CS_ZDM,CS_CS,[loCaseInsensitive, loPartialKey])
   ELSE RESULT:=FALSE;
END;

//在数据集中定位
FUNCTION LOCATE2(DATASET:TDATASET;CS_ZDM1,CS_ZDM2,CS_CS1,CS_CS2: STRING):BOOLEAN;
var dq : TBookMark;
    cd : boolean;
begin
cd:=false;
With DATASET do
     begin
     DisableControls;
     dq:=GetBookmark;
     First;
     While not EOF do
     if (fieldbyname(CS_zdm1).AsString = CS_CS1) AND (fieldbyname(CS_zdm2).AsString = CS_CS2)
     then begin
          cd:=true;
          Break;
          end
          else Next;
      end ;
if not cd then DATASET.GotoBookmark(dq);
DATASET.FreeBookmark(dq);
DATASET.EnableControls;
result:=cd;
end;

//删除数据集中所有数据
procedure SCDB(DATASET: TDATASET);
begin
WITH DATASET DO
     BEGIN
     IF DATASET.ACTIVE
      THEN BEGIN
           WHILE NOT EOF DO
                 BEGIN
                 DATASET.Delete;
                 END;
           END;
     END;
end;

//两查询数据集事物保存
procedure BC_LX(F_QUERY, S_QUERY: TQUERY;CDB_CLDB:TDATABASE);
begin
CDB_CLDB.StartTransaction;
TRY
   F_QUERY.ApplyUpdates;
   S_QUERY.ApplyUpdates;
   CDB_CLDB.Commit;
EXCEPT
   CDB_CLDB.Rollback;
   RAISE;
END;
F_QUERY.CommitUpdates;
S_QUERY.CommitUpdates;
end;

//三查询数据集事物保存
procedure BC_SX(F_QUERY, S_QUERY, T_QUERY: TQUERY;CDB_CLDB:TDATABASE);
begin
CDB_CLDB.StartTransaction;
TRY
   F_QUERY.ApplyUpdates;
   S_QUERY.ApplyUpdates;
   T_QUERY.ApplyUpdates;
   CDB_CLDB.Commit;
EXCEPT
   CDB_CLDB.Rollback;
   RAISE;
END;
F_QUERY.CommitUpdates;
S_QUERY.CommitUpdates;
T_QUERY.CommitUpdates;
end;

//四查询数据集事物保存
procedure BC_SHX(F_QUERY, S_QUERY ,T_QUERY,TH_QUERY: TQUERY;CDB_CLDB:TDATABASE);
begin
CDB_CLDB.StartTransaction;
TRY
   F_QUERY.ApplyUpdates;
   S_QUERY.ApplyUpdates;
   T_QUERY.ApplyUpdates;
   TH_QUERY.ApplyUpdates;
   CDB_CLDB.Commit;
EXCEPT
   CDB_CLDB.Rollback;
   RAISE;
END;
F_QUERY.CommitUpdates;
S_QUERY.CommitUpdates;
T_QUERY.CommitUpdates;
TH_QUERY.ApplyUpdates;
end;

//定位
Function LOCATE3( const cTable: TDATASET;const zdm,sValue: String): Boolean;
var dq : TBookMark;
    cd : boolean;
begin
cd:=false;
With cTable do
     begin
     DisableControls;
     dq:=GetBookmark;
     While not EOF do
     if fieldbyname(zdm).AsString = sValue
     then begin
          cd:=true;
          Break;
          end
          else NEXT;
     if not cd
        then begin
             GotoBookmark(dq);
             While not BOF do
                  if fieldbyname(zdm).AsString = sValue
                       then begin
                            cd:=true;
                            Break;
                            end
                       else Prior;
             end;
     end ;
ctable.FreeBookmark(dq);
cTable.EnableControls;
result:=cd;
end;

//-------------------------------------------------

//在字符串左、右根据输入的参数进行长度补位
FUNCTION AppendSpaceOfStr(SOURCES:STRING;nLen:INTEGER;nType:String;ReplaceStr:String):STRING;
var     StrBuf:String;
        i:Integer;
BEGIN
        StrBuf:='';
        StrBuf:=Trim(SOURCES);
       
        if Uppercase(nType) = 'R' then
        Begin
              for i:=1 to nLen -Length(StrBuf) do
              Begin
                        StrBuf:=StrBuf + ReplaceStr;
              End;
        End;
       
        if Uppercase(nType) = 'L' then
        Begin
              for i:=1 to nLen -Length(StrBuf) do
              Begin
                        StrBuf:=ReplaceStr+StrBuf;
              End;
        End;
        Result :=StrBuf;

END;

//在整数左、右根据输入的参数进行长度补位
FUNCTION AppendSpaceOfInt(SOURCES:INTEGER;nLen:INTEGER;nType:String;ReplaceStr:String):STRING;
var     StrBuf:String;
        i:Integer;
BEGIN
        StrBuf:='';
        StrBuf:=IntToStr(SOURCES);
       
        if Uppercase(nType) = 'R' then
        Begin
              for i:=1 to nLen -Length(StrBuf) do
              Begin
                        StrBuf:=StrBuf + ReplaceStr;
              End;
        End;
       
        if Uppercase(nType) = 'L' then
        Begin
              for i:=1 to nLen -Length(StrBuf) do
              Begin
                        StrBuf:=ReplaceStr+StrBuf;
              End;
        End;
        Result :=StrBuf;
END;

//-------------------------------------------------

//取SOURCES字符串的右WS位
FUNCTION WS_RIGHT(SOURCES :STRING;WS:SHORTINT):STRING;//取SOURCES的右WS位
VAR LI_CD:SHORTINT;
BEGIN
LI_CD:=LENGTH(SOURCES);
IF LI_CD<WS
   THEN RESULT:=''
   ELSE BEGIN
        RESULT:=COPY(SOURCES,LI_CD-WS+1,WS);
        END;

END;

//将CS_SCC删除串 的' '清空
PROCEDURE QK_SCKK(VAR CS_SCC:STRING);
BEGIN
WHILE POS(' ',CS_SCC)>0 DO DELETE(CS_SCC,POS(' ',CS_SCC),1);
END;

//取SOURCES字符串的左WS位
FUNCTION WS_LEFT(SOURCES :STRING;WS:SHORTINT):STRING;
VAR LI_CD:SHORTINT;
BEGIN
LI_CD:=LENGTH(SOURCES);
IF LI_CD<WS
   THEN RESULT:=''
   ELSE BEGIN
        RESULT:=COPY(SOURCES,1,WS);
        END;
END;

//在目标串SOU中查找FGF分格符并将分格符前的串赋予DES返回
FUNCTION FH_JQZFC(FGF:STRING;VAR SOU:STRING):STRING;
VAR WZ:SHORTINT;
BEGIN
WZ:=POS(FGF,SOU);
RESULT:=COPY(SOU,1,WZ-1);
DELETE(SOU,1,WZ);
END;

//返回定长字符串
FUNCTION FHDCZFC(CD:SHORTINT;ZFC:STRING;HJ:BOOLEAN):STRING;
VAR FHC:STRING;
BEGIN
FHC:=ZFC;
WHILE LENGTH(FHC)<CD DO
      BEGIN
      IF HJ THEN FHC:=FHC+' '
            ELSE FHC:=' '+FHC;
      END;
RESULT:=FHC;
END;

 

//***************************大小写转换**********************//
function fenge(p:string):string;
var
  qian,bai,shi,ge:string;
begin
  if copy(p,1,1)='0' then
    qian:=da[0]
  else
    qian:=da[strtoint(copy(p,1,1))]+'仟';
  if copy(p,2,1)='0' then
    bai:=da[0]
  else
    bai:=da[strtoint(copy(p,2,1))]+'佰';
  if copy(p,3,1)='0' then
    shi:=da[0]
  else
    shi:=da[strtoint(copy(p,3,1))]+'拾';
  if copy(p,4,1)='0' then
    ge:=''
  else
    ge:=da[strtoint(copy(p,4,1))];
  qian:=qian+bai+shi+ge;
  qian:=ansireplacestr(qian,'零零','零');
  if qian='零零' then
    result:=''
  else
    begin
     if copy(qian,length(qian)-1,2)='零' then
      delete(qian,length(qian)-1,2);
      result:=qian;
    end;
end;

function xiaotoda(money:string):string;
var
  m,intpart:string;//存放金额字符串
  n:double;//存放由字符串转成的金额
  zf:string[2]; //正负金额
  dotlocation,l:word;//存放小数点位置
  jiao:string[4];//存放角
  fen:string[4]; // 存放分
  yi,wan,jiner:string;
begin
  zf:='';
  if copy(money,0,1)='-' then //四舍五入
    begin
      n:=strtofloat(money)-0.005;
      n:=-n;
      zf:='负';
    end
  else
    n:=strtofloat(money)+0.005;
  m:=floattostr(n); //金额数转成字符串
  dotlocation:=pos('.',m);//小数点的位置
  intpart:=copy(m,0,dotlocation-1);//金额数的整数部分
  jiao:=copy(m,dotlocation+1,1);//获得角
  fen:=copy(m,dotlocation+2,1);//获得分
  l:=length(intpart);//金额整数位数
  while l<12 do//最高只能表示千亿，用零填满前位
    begin
      insert('0',intpart,1);
      l:=l+1;
    end;
  if copy(intpart,1,4)='0000' then//计算亿
    yi:=''
  else
    yi:=fenge(copy(intpart,1,4))+'億';
  if (copy(intpart,5,4)='0000')and (yi='') then //计算万
    wan:=''
  else
    begin
      if (copy(intpart,5,4)='0000') and (yi<>'') then
        wan:='零'
      else
        wan:=fenge(copy(intpart,5,4))+'萬';
    end;

  jiner:=yi+wan+fenge(copy(intpart,9,4))+'圆'; //这里fenge计算千百拾个位，计算出整数位
  jiner:=ansireplacestr(jiner,'零零','零') ;
  if (copy(jiner,length(jiner)-3,2)='零') then
    delete(jiner,length(jiner)-3,2);
  if jiao='0' then //计算角
    jiao:='零'
  else
    jiao:=da[strtoint(jiao)]+'角';
  if fen='0' then  //计算分
    fen:=''
  else
    fen:=da[strtoint(fen)]+'分';
  jiner:=jiner+jiao+fen;//初步合成
  if (copy(jiner,length(jiner)-1,2)='零')  then//如果没有分角则加"整"字
    begin
      delete(jiner,length(jiner)-1,2);//删除末尾"零"字
      jiner:=jiner+'整';
    end;
  if (copy(jiner,1,2)='零') and (copy(jiner,3,2)<>'圆')  then// 如果前导是"零"，除去！
    delete(jiner,1,2);
  if copy(jiner,1,2)='圆'then jiner:='零'+jiner;//如果只有角分则加前导"零圆"！
  result:=zf+jiner;
end;

//***************************大小写转换**********************//

 

(* -------------------------------------------------- *)
(* RightStr
(* =======
(* 取字串的右边若干字元
(* -------------------------------------------------- *)
function RightStr(const sAString: string; iCount: integer): string;
var
iLen: integer;
begin
iLen := Length(sAString);
if iCount > iLen then iCount := iLen;
Result := Copy(sAString, iLen - iCount + 1, iCount);
end; { RightStr }

(* -------------------------------------------------- *)
(* LeftStr
(* =======
(* 取字串的左边若干字元
(* -------------------------------------------------- *)
function LeftStr(const sAString: string; const iCount: integer):string;
begin
 Result := Copy(sAString, 1, iCount);
end; { LeftStr }

{如果您要以中文字为单位, 在 2.0 中文应用组件中也有 AnsiStrCCopy()与
AnsiCopy()可以应用.

这类字串函数(像是PadR, PadL)自己练习写写看其实也挺有趣的; 如果急著要
用,
类似这样子的字串处理函数馆在网路上不少, 例如 Delphi 2.0 深度历险就有
一个叫做 XProc 的档案,
里头就有很多.}

//--------------------------------------
//判断是否为数字
function IsNum(str:string):boolean;
var
  i:integer;
begin
        for i:=1 to length(str) do
        begin
                if not (str[i] in ['0'..'9']) then
                        IsNum := False
                else
                        IsNum := True;
        end;
end;
//--------------------------------------

 

//**************************************//
function Encrypt(const S: String; Key: Word): String;//字符串加密
var
   I: Integer;
begin
  Result := S;
  for I := 1 to Length(S) do
      begin
           Result[I] := char(byte(S[I]) xor (Key shr 11));
           Key := (byte(Result[I]) + Key) * C1 + C2;
      end;
  end;

//**************************************//
function Decrypt(const S: String; Key: Word): String; //字符串解密
var
   I: Integer;
begin
  Result := S;
  for I := 1 to Length(S) do
      begin
           Result[I] := char(byte(S[I]) xor (Key shr 11));
           Key := (byte(S[I]) + Key) * C1 + C2;
      end;
  end;

//**************************************//
procedure EncryptFile(INFName, OutFName : String; Key : Word);  //文件加密
VAR
   MS, SS : TMemoryStream;
   X : Integer;
   C : Byte;
begin
MS := TMemoryStream.Create;
SS := TMemoryStream.Create;
    TRY
       MS.LoadFromFile(INFName);
       MS.Position := 0;
       FOR X := 0 TO MS.Size - 1 DO
             begin
                  MS.Read(C, 1);
                  C := (C xor (Key shr 8));
                  Key := (C + Key) * C1 + C2;
                  SS.Write(C,1);
             end;
       SS.SaveToFile(OutFName);
    FINALLY
           SS.Free;
           MS.Free;
    end;
end;

//**************************************//
procedure DecryptFile(INFName, OutFName : String; Key : Word);  //文件解密
VAR
   MS, SS : TMemoryStream;
   X : Integer;
   C, O : Byte;
begin
MS := TMemoryStream.Create;
SS := TMemoryStream.Create;
    TRY
       MS.LoadFromFile(INFName);
       MS.Position := 0;
       FOR X := 0 TO MS.Size - 1 DO
             begin
                  MS.Read(C, 1);
                  O := C;
                  C := (C xor (Key shr 8));
                  Key := (O + Key) * C1 + C2;
                  SS.Write(C,1);
             end;
       SS.SaveToFile(OutFName);
    FINALLY
           SS.Free;
           MS.Free;
    end;
end;

 

//处理网络资源的永久连接
Function Connettion(FileListName,ServerIP,UserName,UserPWD:String):integer;
Var
    NR: NETRESOURCE;
    Ret: DWORD;
    S: string;
    Ret_dir:Integer;
    f: TSearchRec;
Begin
        {***************用于网络资源的永久连接***********************}
        Ret_dir:=FindFirst(FileListName, faAnyFile, f);
        if Ret_dir<>0 then
        Begin
                S := '//'+ServerIP;
                NR.dwType := RESOURCETYPE_ANY;
                NR.lpLocalName := nil;
                NR.lpRemoteName := PChar(S);
                NR.lpProvider := nil;
                //调用WNetAddConnection2，此函数在windows单元中，建立永久连接
                Ret := WNetAddConnection2(NR,PChar(UserPWD),PChar(UserName),CONNECT_UPDATE_PROFILE);
                //if Ret <> NO_ERROR then
                //Begin
                        //if Ret <> ERROR_EXTENDED_ERROR then RaiseLastWin32Error
                        //else CallNetExtError;
                       
                //End;
        End;
        RESULT:=Ret;
End;

//**************************************//
Function GetFileText(Filename,ReamName,FilePath:String):TStringList;//处理读取文件内容
Var
    DirName,sText,FileDate: string;
    FTextFile:TextFile;  //
    DstList: TStringList;
   
Begin
        FileDate:='';
        DirName:='';
        sText:='';
       
        FileDate:=formatdatetime('yyyymmdd',now);
        DstList:=TStringList.Create;
        DirName:=FilePath+Filename+FileDate+'.'+ReamName;
        try
                //读取文件
                if FileExists(DirName) then
                Begin
                        AssignFile(FTextFile,DirName);   //load file
                        Reset(FTextFile); //setting file read only
                        DstList.Clear;
                        while not eof(FTextFile) do
                        Begin
                                readln(FTextFile,sText);   //read a line of file
                                DstList.Text:=DstList.Text + sText;
                        End;
                        CloseFile(FTextFile);
                End;
        finally
                DstList.Free;
        End;
        RESULT:=DstList;
End;

//***************************大小写转换**********************//

//***************************Unicode转换*********************//
function ChangeOrder(OriStr:String;TotalLen:Integer):String;
var
  i:Integer;
  TempStr:String;
begin
  OriStr:=OriStr+Copy('FFFFFFFFFF',1,TotalLen-Length(OriStr));

  TempStr:='';
  for i:=1 to (TotalLen Div 2) do
    TempStr:=TempStr+OriStr[i*2]+OriStr[i*2-1];

  Result:=TempStr;
end;

function ResumeOrder(OriStr:String):String;
var
  i:Integer;
  TempStr:String;
begin
  TempStr:='';
  for i:=1 to (Length(OriStr) Div 2) do
    TempStr:=TempStr+OriStr[i*2]+OriStr[i*2-1];

  Result:=StringReplace(TempStr,'F','',[rfReplaceAll]);
end;

Function Mix2PDU(CenterNumber,CalledNumber,ShortMsg:String):String;
var
  TempStr,MsgContent:String;
  PDURec:TPDUFormatRec;
begin
  PDURec.CenterLen := '08';
  PDURec.CenterType := '91';
  TempStr := ChangeOrder(CenterNumber,14);
  Move(TempStr[1],PDURec.CenterNumber[0],14);

  PDURec.FileHeader := '11';
  PDURec.SMType := '00';
  PDURec.CalledLen := '0B';
  PDURec.CalledType := '81';

  TempStr := ChangeOrder(CalledNumber,12);
  Move(TempStr[1],PDURec.CalledNumber[0],12);

  PDURec.SMCodeType := '0000A7';

  MsgContent := EnCodeUniCode(ShortMsg);
  Move(IntToHex(Length(ShortMsg),2)[1],PDURec.SMLen[0],2);

  SetLength(Result,SizeOf(PDURec));
  Move(PDURec,Result[1],SizeOf(PDURec));
  Result:=Result+MsgContent;
end;

function EncodeUniCode(s:WideString):String;
var
  i,len:Integer;
  cur:Integer;
  t:String;
begin
  Result:='';
  len:=Length(s);
  i:=1;

  while i<=len do
  begin
    cur:=ord(s[i]);
    //BCD转换

    //FmtStr(t,'%4.4X',[cur]);

    Result:=Result+IntToHex(Cur,4)+' ';
    inc(i);
  end;
end;

function DecodeUniCode(s:String):WideString;
var
  p:PWord;
  i,len:Integer;
  cur:Integer;
  TempChar:WideChar;
  t:String;
begin
  New(p);

  Result:='';
  len:=Length(s) div 4;
  i:=1;

  for i:=0 to Len-1 do
  begin
    t:=Copy(s,4*i+1,4);
    p^:=HexToInt(t);

    Move(p^,TempChar,2);
    Result:=Result+TempChar+' ';
  end;

  Dispose(p);
end;

function MixSendPDU(Phone,ShortMsg:String;Var SendLen:String;SMType:Integer):String;
var
  PDUSendRec:TPDUSendRec;
  TempStr:String;
begin
  PDUSendRec.SMSCLength := '00';
  PDUSendRec.FirstOctet := '11';
  PDUSendRec.MessageReference := '00';
  PDUSendRec.PhoneLength := '0B';
  PDUSendRec.AddressType := '91';

  TempStr:=ChangeOrder(Phone,12);
  Move(TempStr[1],PDUSendRec.Phone[0],12);

  PDUSendRec.TPPID := '00';

  Case SMType of
    0://Englsih
      PDUSendRec.TPDCS := '00';
    4://8Bits
      PDUSendRec.TPDCS := '04';
    else //Chinese
      PDUSendRec.TPDCS := '08';
  end;

  PDUSendRec.TPValidityPeriod := 'AA';

  Case SMType of
    0://Englsih
    begin
      Move(IntToHex(Length(ShortMsg),2)[1],PDUSendRec.TPUserDataLength[0],2);
      SetLength(Result,SizeOf(PDUSendRec));
      Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
      Result:=Result+EncodeEnglish(ShorTMsg);
      SendLen:=IntToStr((Length(Result)-2) Div 2);
    end;

    4://8Bits
    begin
      Move(IntToHex(Length(ShortMsg),2)[1],PDUSendRec.TPUserDataLength[0],2);
      SetLength(Result,SizeOf(PDUSendRec));
      Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
      Result:=Result+Encode8Bits(ShorTMsg);
      SendLen:=IntToStr((Length(Result)-2) Div 2);
    end;

    else //Chinese
    begin
      //TempStr:=EnCodeUniCode(ShortMsg);
      TempStr:= ShortMsg;
      Move(IntToHex(Length(TempStr) Div 2,2)[1],PDUSendRec.TPUserDataLength[0],2);
      SetLength(Result,SizeOf(PDUSendRec));
      Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
      Result:=Result+TempStr;
      SendLen:=IntToStr((Length(Result)-2) Div 2);
    end;
  end;
end;

function EncodeEnglish(s:String):String;
var
  i,j,len:Integer;
  cur,Int1:Integer;
begin
  len:=Length(s);

  //j 用于移位计数
  i:=1;
  j:=0;

  while i<=len do
  begin
    if i<len then
      //数据变换
      cur:=(ord(s[i]) shr j) or ((ord(s[i+1]) shl (7-j)) and $ff)
    else
      cur:=(ord(s[i]) shr j) and $7f;

    Result:=Result+IntToHex(cur,2);
    inc(i);

    //移位计数达到7位的特别处理
    j:=(j+1) mod 7;
    if j=0 then inc(i);
  end;
end;

function DecodeEnglish(s:String):String;
var
  i,j,len:Integer;
  TempIntArray:Array of Integer;
  TempStr:String;
  cur,Int1:Integer;
begin
  len:=Length(s) div 2;
  SetLength(TempIntArray,Len);

  for i:=0 to Len-1 do
  begin
    TempStr:=Copy(s,i*2+1,2);
    TempIntArray[i]:=HexToInt(TempStr);
  end;

  //j 用于移位计数
  i:=0;
  j:=0;

  while i<=len-1 do
  begin
    if i<>0 then
      //数据变换
      cur:=((TempIntArray[i] shl j) and $7f) or (TempIntArray[i-1] shr (8-j))
    else
      cur:=(TempIntArray[i] shl j) and $7f;

    Result:=Result+Chr(cur);

    //移位计数达到7位的特别处理
    j:=(j+1) mod 7;
    if j=0 then
    begin
      cur:=TempIntArray[i] shr 1;
      Result:=Result+Chr(cur);
    end;

    inc(i);
  end;
end;

function DisposeReadPDU(PDUData:String;Var Phone,MsgContent:String):Integer;
var
  TempInt,Len:Integer;
  FirstReadRec:TPDUFirstReadRec;
  SecondReadRec:TPDUSecondReadRec;
  TempStr:String;
begin
  //First Read Record
  Move(PDUData[1],FirstReadRec,SizeOf(FirstReadRec));
  TempInt:=HexToInt(FirstReadRec.SendPhoneLength);
  if (TempInt mod 2 = 1) then
    Inc(TempInt);

  //Phone
  Phone:=Copy(PDUData,SizeOf(FirstReadRec)+1,TempInt);
  Phone:=ResumeOrder(Phone);

  //Second Read Record
  Move(PDUData[SizeOf(FirstReadRec)+TempInt+1],SecondReadRec,SizeOf(SecondReadRec));

  //Message Length
  Len:=HexToInt(SecondReadRec.TPUserDataLength)*2;

  //Short Message Content
  TempStr:=Copy(PDUData,SizeOf(FirstReadRec)+TempInt+SizeOf(SecondReadRec)+1,Len);

  Case HexToInt(SecondReadRec.TPDCS) of
    0..3://7 Bits
    begin
      MsgContent:=DecodeEnglish(TempStr);
    end;

    4..7://8 Bits
    begin
      MsgContent:=Decode8Bits(TempStr);
    end;

    8..11://UniCode
    begin
      MsgContent:=DecodeUniCode(TempStr);
    end;

    else
    begin
      Result:=1;          //type Error
      Exit;
    end;
  end;
end;

function Encode8Bits(s:String):String;
var
  i:Integer;
begin
  Result:='';
  for i:=1 to Length(s) do
    Result:=Result+IntToHex(Ord(s[i]),2);
end;

function Decode8Bits(s:String):String;
var
  i,Len:Integer;
  TempStr:String;
begin
  Result:='';
  Len:=Length(s) Div 2;

  for i:=0 to Len-1 do
  begin
    TempStr:=Copy(s,i*2+1,2);

    Result:=Result+Chr(HexToInt(TempStr));
  end;
end;

//****************************Unicode转换******************//

//================================================================
Procedure DyDbgDataLine(sValue:string;tab:Ttable;dsr:TDatasource);
var
   bookmark:TBookMark;
begin
   //记录当前标记的行；
  bookmark:=tab.GetBookmark;
  tab.first;
  while not tab.Eof do
  begin
        if tab.FieldByName('cpbh').AsString= sValue then
        begin
                bookmark:=tab.GetBookmark;
                break;
        end;
        tab.Next;
  end;
  dsr.DataSet.GotoBookmark(pointer(bookmark));
End;

procedure DrawLine(tab:Ttable;const Rect:Trect;Field:Tfield;state:TgridDrawState;dbg:TDBGrid);
begin
        if (tab.fieldbyname('zdm').asstring = '9')then
        begin
                dbg.canvas.font.color:=clred;
                dbg.canvas.brush.color:=clyellow;
        end;
        dbg.DefaultDrawDataCell(Rect,Field,State);
end;

function myround(const yuan: Extended; const pp: Integer): Extended;
//yuan:原浮点数，PP保留 小数点后第几位
var
        p,l,m,l2:Longint;
        s:string; // 原浮点数
        sq:string; // 小数点前
        sh:string;//小数点后
begin
        if yuan=0 then exit;// 原浮点数 0
        if pp<0 then exit; //非法小数点后第几位
        s:=floattostr(yuan);
        p:=pos('.',s);   //小数点位置
        sq:=midstr(s,1,p-1);
        sh:=midstr(s,p+1,length(s)-length(sq)-1);
        l:=length(sh);//小数位数
        l2:=length(sq);//整数位数
        if pp>=l then
        begin//0
                result:=strtofloat(s);
                exit;//比如 11。06 要保留到 小数点后第3位显然 不合理
        end;//
        { if pp=l then  //比如 11。06 要保留到 小数点后第2位不用处理 直接返回
        begin//1
                Result:=s;
                exit;
        end;//1 }
        if pp<l then //比如 11。06 要保留到 小数点后第1位 ，。。。
        begin//2
                m:=strtoint(sh[pp+1]);
                if m>=5 then
                begin
                        if pp>=1 then //保留到 小数点后第1，2。。。位
                        begin//3
                                sh:=midstr(sh,1,pp);
                                sh := inttostr(strtoint(sh)+1);
                                if length(sh)>pp then
                                begin
                                        sh:= midstr(sh,2,pp);
                                        sq:= inttostr(strtoint(sq)+1);
                                end;
                                Result:=strtofloat(sq+'.'+sh);
                                exit;
                        end//3
                        else  //保留到 小数点后第0位
                        begin//4
                                sq[l2]:=chr(ord(sq[l2])+1);
                                Result:=strtofloat(sq);
                                exit;
                        end;//4
                end
                else
                begin
                        if pp>=1 then //保留到 小数点后第1，2。。。位
                        begin//3
                                sh:=midstr(sh,1,pp);
                                Result:=strtofloat(sq+'.'+sh);
                                exit;
                        end//3
                        else  //保留到 小数点后第0位
                        begin//4
                                Result:=strtofloat(sq);
                                exit;
                        end;//4
                end;
        end;//2
end;
//================================================================

{=================================================================
  功  能:得到汉字笔画
  参  数: chnstr(汉字)
  返回值: integer(笔画)
  备 注:
  版 本:
     1.0  2005/10/09 09:55:00
=================================================================}
function GetBiHua(chnstr:string):integer;
const
        BiHuaTable=#10#7#10#10#8#10#9#11#17#14#13#5#13#10#12#15
                +#10#6#10#9#12#8#10#10#8#8#10#5#10#14#16#9
                +#12#12#15#15#7#10#5#5#7#10#2#9#4#8#12#13
                +#7#10#7#21#10#8#5#9#6#13#8#8#9#13#12#10
                +#13#7#10#10#8#8#7#8#7#19#5#4#8#6#9#10
                +#14#14#9#12#15#10#15#12#12#8#9#5#15#10#16#13
  +#9#12#8#8#8#7#15#10#13#19#8#13#12#8#5#12
  +#9#4#9#10#7#8#12#12#10#8#8#5#11#11#11#9
  +#9#18#9#12#14#4#13#10#8#14#13#14#6#10#9#4
  +#7#13#6#11#14#5#13#16#17#16#9#18#5#12#8#9
  +#9#8#4#16#16#17#12#9#11#15#8#19#15#7#15#11
  +#12#16#13#10#13#7#6#9#5#8#9#9#10#6#9#11
  +#15#8#10#8#12#9#13#10#14#7#8#11#11#14#12#8
  +#7#10#2#10#7#11#4#5#7#19#10#8#17#11#12#7
  +#3#7#13#15#8#11#11#14#16#8#10#9#11#11#7#7
  +#10#4#7#17#16#16#15#11#9#8#12#8#5#9#7#19
  +#12#3#9#9#9#14#12#14#7#9#8#8#10#10#12#11
  +#11#12#11#13#11#6#11#19#8#11#6#9#11#4#11#7
  +#2#12#8#11#10#12#7#9#12#15#15#11#7#8#4#7
  +#15#12#7#15#10#6#7#6#11#7#7#7#12#8#15#10
  +#9#16#6#7#8#12#12#15#8#8#10#10#10#6#13#9
  +#11#6#7#6#6#10#8#8#4#7#10#5#9#6#6#6
  +#11#8#8#13#12#14#13#13#13#4#11#14#4#10#7#5
  +#16#12#18#12#13#12#9#13#10#12#24#13#13#5#12#3
  +#9#13#6#11#12#7#9#12#15#7#6#6#7#8#11#13
  +#8#9#13#15#10#11#7#21#18#11#11#9#14#14#13#13
  +#10#7#6#8#12#6#15#12#7#5#4#5#11#11#15#14
  +#9#19#16#12#14#11#13#10#13#14#11#14#7#6#3#14
  +#15#12#11#10#13#12#6#12#14#5#3#7#4#12#17#9
  +#9#5#9#11#9#11#9#10#8#4#8#10#11#9#5#12
  +#7#11#11#8#11#11#6#9#10#9#10#2#10#17#10#7
  +#11#6#8#15#11#12#11#15#11#8#19#6#12#12#17#14
  +#4#12#7#14#8#10#11#7#10#14#14#7#8#6#12#11
  +#9#7#10#12#16#11#13#13#9#8#16#9#5#7#7#8
  +#11#12#11#13#13#5#16#10#2#11#6#8#10#12#10#14
  +#15#8#11#13#2#7#5#7#8#12#13#8#4#6#5#5
  +#12#15#6#9#8#9#7#9#11#7#4#9#7#10#12#10
  +#13#9#12#9#10#11#13#12#7#14#7#9#12#7#14#12
  +#14#9#11#12#11#7#4#5#15#7#19#12#10#7#9#9
  +#12#11#9#6#6#9#13#6#13#11#8#12#11#13#10#12
  +#9#15#6#10#10#4#7#12#11#10#10#6#2#6#5#9
  +#9#2#9#5#9#12#6#4#9#8#9#18#6#12#18#15
  +#8#8#17#3#10#4#7#8#8#5#7#7#7#7#4#8
  +#8#6#7#6#6#7#8#11#8#11#3#8#10#10#7#8
  +#8#8#9#7#11#7#8#4#7#7#12#7#10#8#6#8
  +#12#12#4#9#8#13#10#12#4#9#11#10#5#13#6#8
  +#4#7#7#4#15#8#14#7#8#13#12#9#11#6#9#8
  +#10#11#13#11#5#7#7#11#10#10#8#11#12#8#14#9
  +#11#18#12#9#12#5#8#4#13#6#12#4#7#6#13#8
  +#15#14#8#7#13#9#11#12#3#5#7#9#9#7#10#13
  +#8#11#21#4#6#9#9#7#7#7#12#7#16#10#10#14
  +#10#16#13#15#15#7#10#14#12#4#11#10#8#12#9#12
  +#10#12#9#12#11#3#6#9#10#13#10#7#8#19#10#10
  +#11#3#7#5#10#11#8#10#4#9#3#6#7#9#7#6
  +#9#4#7#8#8#9#8#8#11#12#11#8#14#7#8#8
  +#8#13#5#11#9#7#8#9#10#8#12#8#5#9#14#9
  +#13#8#8#8#12#6#8#9#6#14#11#23#11#20#8#6
  +#3#10#13#8#6#11#5#7#9#6#9#8#9#10#8#13
  +#9#8#12#13#12#12#10#8#8#14#6#9#15#9#10#10
  +#6#10#9#12#15#7#12#7#11#12#8#12#7#16#16#10
  +#7#16#10#11#6#5#5#8#10#17#17#14#11#9#6#10
  +#5#10#8#12#10#11#10#5#8#7#6#11#13#9#8#11
  +#14#14#15#9#15#12#11#9#9#9#10#7#15#16#9#8
  +#9#10#9#11#9#7#5#6#12#9#12#7#9#10#6#8
  +#5#8#13#10#12#9#15#8#15#12#8#8#11#7#4#7
  +#4#7#9#6#12#12#8#6#4#8#13#9#7#11#7#6
  +#8#10#7#12#10#11#10#12#13#11#10#9#4#9#12#11
  +#16#15#17#9#11#12#13#10#13#9#11#6#9#12#17#9
  +#12#6#13#10#15#5#12#11#10#11#6#10#5#6#9#9
  +#9#8#11#13#9#11#17#9#6#4#10#8#12#16#8#11
  +#5#6#11#6#13#15#10#14#6#5#9#16#4#7#10#11
  +#12#6#7#12#13#20#12#3#9#10#6#7#13#6#9#2
  +#10#3#13#7#16#8#6#11#8#11#9#11#11#4#5#9
  +#7#7#7#10#6#14#9#6#8#10#5#9#12#10#5#10
  +#11#15#6#9#8#13#7#10#7#6#11#7#13#10#8#8
  +#6#12#9#11#9#14#12#8#10#13#9#11#11#9#14#13
  +#12#9#4#13#15#6#10#10#9#8#11#12#12#8#15#9
  +#9#10#6#19#12#10#9#6#6#13#8#15#12#17#12#10
  +#6#8#9#9#9#20#12#11#11#8#11#9#7#9#16#9
  +#13#11#14#10#10#5#12#12#11#9#11#12#6#14#7#5
  +#10#8#11#13#14#9#9#13#8#7#17#7#9#10#4#9
  +#9#8#3#12#4#8#4#9#18#10#13#4#13#7#13#10
  +#13#7#10#10#6#7#9#14#8#13#12#16#8#11#14#13
  +#8#4#19#12#11#14#14#12#16#8#10#13#11#10#8#9
  +#12#12#7#5#7#9#3#7#2#10#11#11#5#6#13#8
  +#12#8#17#8#8#10#8#8#11#7#8#9#9#8#14#7
  +#11#4#8#11#15#13#10#5#11#8#10#10#12#10#10#11
  +#8#10#15#23#7#11#10#17#9#6#6#9#7#11#9#6
  +#7#10#9#12#10#9#10#12#8#5#9#4#12#13#8#12
  +#5#12#11#7#9#9#11#14#17#6#7#4#8#6#9#10
  +#15#8#8#9#12#15#14#9#7#9#5#12#7#8#9#10
  +#8#11#9#10#7#7#8#10#4#11#7#3#6#11#9#10
  +#13#8#14#7#12#6#9#9#13#10#7#13#8#7#10#12
  +#6#12#7#10#8#11#7#7#3#11#8#13#12#9#13#11
  +#12#12#12#8#8#10#7#9#6#13#12#8#8#12#14#12
  +#14#11#10#7#13#13#11#9#8#16#12#5#15#14#12#9
  +#16#12#9#13#11#12#10#11#8#10#10#10#7#7#6#8
  +#9#13#10#10#11#5#13#18#16#15#11#17#9#16#6#9
  +#8#12#13#7#9#11#11#15#16#10#10#13#11#7#7#15
  +#5#10#9#6#10#7#5#5#10#4#7#12#8#9#12#5
  +#11#7#8#2#14#10#9#12#10#7#18#13#8#10#8#11
  +#11#12#10#9#8#13#10#11#13#7#7#11#12#12#9#10
  +#15#11#14#7#16#14#5#15#2#14#17#14#10#6#12#10
  +#6#11#12#8#17#16#9#7#20#11#15#10#7#8#9#11
  +#13#13#10#7#11#10#7#10#8#11#5#5#13#11#14#12
  +#13#10#6#15#10#9#4#5#11#8#11#16#11#8#8#7
  +#13#9#12#12#14#8#7#5#11#7#8#11#7#8#12#19
  +#13#21#13#10#11#16#11#8#7#15#7#6#11#8#10#15
  +#12#12#10#12#9#11#13#11#9#10#9#13#7#7#11#11
  +#7#8#6#4#7#7#6#11#17#8#11#13#14#14#13#12
  +#9#9#9#6#11#7#8#9#3#9#14#6#10#6#7#8
  +#6#9#15#14#12#13#14#11#14#14#13#6#9#8#8#6
  +#10#11#8#13#4#5#10#5#8#9#12#14#9#3#8#8
  +#11#14#15#13#7#9#12#14#7#9#9#12#8#12#3#7
  +#5#11#13#17#13#13#11#11#8#11#16#19#17#9#11#8
  +#6#10#8#8#14#11#12#12#10#11#11#7#9#10#12#9
  +#8#11#13#17#9#12#8#7#14#5#5#8#5#11#10#9
  +#8#16#8#11#6#8#13#13#14#19#14#14#16#15#20#8
  +#5#10#15#16#8#13#13#8#11#6#9#8#7#7#8#5
  +#13#14#13#12#14#4#5#13#8#16#10#9#7#9#6#9
  +#7#6#2#5#9#8#9#7#10#22#9#10#9#8#11#8
  +#10#4#14#10#8#16#10#8#5#7#7#10#13#9#13#14
  +#8#6#15#15#11#8#10#14#5#7#10#10#19#11#15#15
  +#10#11#9#8#16#5#8#8#4#7#9#7#10#9#6#7
  +#5#7#9#3#13#9#8#9#17#20#10#10#8#9#8#18
  +#7#11#7#11#9#8#8#8#12#8#11#12#11#12#9#19
  +#15#11#15#9#10#7#9#6#8#10#16#9#7#8#7#9
  +#10#12#8#8#9#11#14#12#10#10#8#7#12#9#10#8
  +#11#15#12#13#12#13#16#16#8#12#11#13#8#9#21#7
  +#8#15#12#9#11#12#10#5#4#12#15#7#20#15#11#4
  +#12#15#14#16#11#14#16#9#13#8#9#13#6#8#8#11
  +#5#8#10#7#9#8#8#11#11#10#14#8#11#10#5#12
  +#4#10#12#11#13#10#6#10#12#10#14#19#18#12#12#10
  +#11#8#2#10#14#9#7#8#12#8#7#11#11#10#6#14
  +#8#6#11#10#6#3#6#7#9#9#16#4#6#7#7#8
  +#5#11#9#9#9#6#8#10#3#6#13#5#12#11#16#10
  +#10#9#15#13#8#15#11#12#4#14#8#7#12#7#14#14
  +#12#7#16#14#14#10#10#17#6#8#5#16#15#12#10#9
  +#10#4#8#5#8#9#9#9#9#10#12#13#7#15#12#13
  +#7#8#9#9#10#10#11#16#12#12#11#8#10#6#12#7
  +#9#5#7#11#7#5#9#8#12#4#11#6#11#8#7#11
  +#8#11#17#15#5#11#23#6#16#9#6#11#10#4#8#4
  +#10#8#16#7#13#14#12#11#12#13#12#16#5#9#22#20
  +#20#20#5#9#7#9#12#10#4#4#2#7#7#6#4#3
  +#7#6#5#4#4#6#9#13#9#16#14#13#10#9#4#12
  +#9#6#9#20#16#17#6#10#8#6#2#15#8#6#15#13
  +#12#7#10#8#10#15#9#11#13#17#13#14#3#8#6#12
  +#10#13#8#12#12#6#12#13#6#10#12#14#10#9#6#8
  +#7#7#13#11#13#12#10#9#8#7#3#7#14#8#5#8 
  +#16#17#16#12#6#10#15#14#6#11#12#10#3#8#14#11
  +#10#12#10#6#3#14#4#10#7#8#11#11#11#6#8#11
  +#13#10#13#10#7#6#10#5#8#7#7#11#10#8#9#7
  +#8#11#9#8#13#11#7#5#12#9#4#11#9#11#12#9
  +#5#6#5#9#9#12#8#3#8#2#5#9#7#4#9#9
  +#8#7#5#5#8#9#8#8#6#5#3#5#9#8#9#14
  +#10#8#9#13#16#9#5#8#12#8#4#5#9#9#8#8
  +#6#4#9#6#7#11#11#8#14#11#15#8#11#10#7#13
  +#8#12#11#12#4#12#11#15#16#12#17#13#13#12#13#12
  +#5#8#9#7#6#9#14#11#13#14#10#8#9#14#10#5
  +#5#10#9#17#4#11#10#4#13#12#7#17#9#12#9#11
  +#10#8#12#15#15#9#7#5#5#6#13#6#13#5#7#6
  +#8#3#8#10#8#10#9#7#6#9#12#15#16#14#7#12
  +#9#10#10#12#14#13#13#11#7#8#14#13#14#9#11#11
  +#10#21#13#6#17#12#14#10#6#10#10#13#11#10#14#11
  +#10#12#8#13#5#5#6#12#16#9#17#15#9#8#8#5
  +#10#11#4#8#7#7#13#8#15#13#7#17#13#15#14#10
  +#8#12#10#14#11#5#9#6#13#13#11#12#15#10#16#10
  +#15#11#15#10#11#10#13#10#11#10#9#11#10#5#10#10
  +#18#13#10#13#11#10#15#12#12#15#16#12#7#12#17#11
  +#10#9#8#4#11#13#5#11#9#14#12#9#7#8#11#13
  +#9#10#8#4#7#9#5#6#11#9#9#9#12#10#10#13
  +#17#6#11#7#12#11#10#12#9#12#11#7#5#10#5#7
  +#9#8#10#10#10#11#3#6#8#12#6#11#13#13#13#13
  +#9#7#4#17#8#6#11#10#7#6#8#12#7#8#11#9
  +#9#12#9#9#4#10#9#5#15#9#12#8#10#3#11#7
  +#13#10#11#12#11#8#11#3#12#7#4#3#8#6#8#8
  +#11#7#6#9#20#13#6#4#7#10#7#11#11#4#14#11
  +#7#11#8#6#6#7#7#5#14#8#9#9#12#17#7#12
  +#11#11#15#3#14#12#10#4#9#7#7#14#10#6#13#10
  +#8#9#13#10#12#7#14#8#12#7#7#7#9#4#6#9
  +#9#4#7#11#7#7#4#8#4#10#4#14#6#9#7#5
  +#13#11#8#4#5#10#9#8#14#8#6#11#8#12#15#6
  +#13#10#12#10#7#11#15#3#11#14#11#13#6#12#17#11
  +#10#3#13#12#11#9#7#12#6#8#15#9#7#17#14#13
  +#9#8#9#3#12#10#6#11#13#6#5#14#6#9#8#11
  +#11#7#9#8#13#9#9#8#13#7#13#11#12#9#10#8
  +#8#9#11#22#9#15#17#12#3#12#10#8#13#9#8#9
  +#9#15#13#6#11#11#12#15#9#10#18#12#10#10#11#10
  +#3#7#10#7#11#10#10#13#8#13#15#15#6#9#13#6
  +#11#8#11#5#11#9#19#16#8#8#12#10#16#7#12#8
  +#7#13#7#4#9#11#9#13#12#12#6#6#9#7#6#6
  +#16#8#7#8#8#5#4#10#6#7#12#14#6#9#10#6
  +#13#12#7#10#10#14#6#14#11#14#9#10#6#13#11#9
  +#6#7#10#9#12#12#11#11#7#12#9#11#11#5#9#19
  +#10#9#13#16#8#5#11#6#9#14#12#6#8#6#6#6
  +#10#6#5#5#9#6#6#8#9#10#7#3#7#4#10#11
  +#13#11#12#9#6#6#11#9#11#10#11#10#7#9#12#8
  +#6#7#15#11#8#8#8#11#11#9#14#10#12#16#6#9
  +#12#10#9#12#10#11#10#9#5#10#10#7#6#8#8#6
  +#9#6#10#6#11#9#10#14#16#13#7#14#13#6#13#11
  +#12#9#9#10#9#9#20#12#15#8#6#11#7#3#6#11
  +#5#5#6#12#8#11#1#12#7#12#11#8#6#6#13#6
  +#12#11#5#10#14#7#8#9#18#12#9#10#3#1#7#4
  +#4#7#8#7#6#3#7#17#11#13#9#6#13#13#15#4
  +#3#10#13#8#5#10#7#6#17#11#8#9#9#6#10#9
  +#6#9#7#11#11#11#7#4#4#11#5#8#15#11#18#7
  +#14#10#11#11#9#14#7#17#9#15#13#10#9#9#8#7
  +#17#10#11#13#14#13#8#8#10#5#11#9#5#9#6#11
  +#7#4#5#7#10#7#8#12#7#6#4#5#7#12#9#2
  +#5#6#11#3#8#13#13#13#14#7#9#12#8#12#12#11
  +#11#4#10#8#3#6#9#6#9#6#5#11#6#8#6#12
  +#12#10#12#13#11#9#8#13#10#12#12#10#15#5#10#11
  +#10#4#9#10#10#12#14#7#7#10#13#13#12#7#8#14
  +#9#9#4#6#12#11#9#8#12#4#10#10#10#4#9#4
  +#9#4#7#15#11#10#13#5#5#10#6#10#9#7#10#10
  +#6#6#9#19#12#16#10#10#12#14#17#12#19#8#6#16
  +#9#20#16#10#7#7#17#8#8#6#8#10#9#15#15#12
  +#16#4#12#12#5#5#11#8#9#9#14#8#5#9#7#14
  +#10#6#10#10#14#18#9#13#11#8#10#8#14#11#10#22
  +#9#5#9#10#12#11#15#11#14#14#7#12#10#7#3#7
  +#8#5#8#16#13#8#9#7#8#9#13#13#6#14#5#14
  +#7#10#12#16#8#13#14#7#10#9#13#10#13#10#16#6
  +#7#8#8#10#7#15#10#15#6#13#9#11#8#9#6#8
  +#16#9#5#9#9#10#8#7#6#8#4#7#14#8#8#10
  +#5#3#8#11#8#12#12#6#10#8#7#9#4#11#5#6
  +#7#7#10#11#6#10#13#8#9#8#12#10#13#8#8#11
  +#12#8#11#4#9#8#9#10#8#9#8#9#6#6#6#8
  +#6#9#7#12#9#7#8#8#10#8#9#17#10#10#12#6
  +#11#10#8#10#6#10#12#8#17#15#5#11#9#7#11#8
  +#12#12#7#8#9#8#7#4#9#4#9#8#15#14#15#10
  +#6#12#6#15#6#7#12#13#9#14#7#11#10#10#10#8
  +#8#10#12#8#10#11#11#7#9#9#9#10#9#12#11#7
  +#12#5#9#13#3#6#11#6#18#12#15#8#11#9#7#7
  +#7#9#12#10#7#8#11#9#7#7#8#10#20#16#15#12
  +#13#12#15#9#5#7#9#11#7#7#10#0#0#0#0#0
  +#3#3#3#4#4#4#5#6#6#10#10#16#0#9#0#2
  +#3#4#4#5#5#6#9#11#14#14#19#0#8#14#2#6
  +#4#7#7#11#14#4#6#10#11#12#14#15#16#0#5#8
  +#11#11#15#8#7#0#4#6#7#8#8#8#9#10#10#10
  +#13#13#14#14#15#16#0#8#0#4#4#4#5#5#5#5
  +#6#6#6#6#6#6#6#6#6#7#7#7#7#7#7#7
  +#7#7#8#8#8#8#8#8#8#8#8#8#8#8#9#9
  +#9#9#9#9#9#9#9#10#10#10#10#10#10#10#10#10
  +#10#10#10#10#11#11#11#11#11#11#11#12#12#12#13#14
  +#14#14#14#14#14#15#15#5#6#7#7#8#17#6#8#4
  +#12#16#17#18#21#0#9#9#11#6#6#7#0#8#10#10
  +#11#12#12#12#13#16#19#19#0#6#8#8#10#0#10#10
  +#0#5#5#5#6#6#6#7#7#7#7#7#7#8#8#8
  +#8#8#8#8#8#8#8#8#9#9#9#9#10#10#10#10
  +#10#10#10#11#11#11#11#11#11#11#11#11#11#11#12#12
  +#12#12#12#13#13#14#14#14#15#15#19#0#8#0#5#5
  +#6#6#7#7#7#7#8#9#9#10#10#10#11#11#11#16
  +#5#5#5#5#6#6#7#7#7#7#7#7#8#8#8#8
  +#8#8#8#9#9#9#9#9#10#10#11#11#13#13#13#14
  +#14#16#19#20#5#7#5#7#7#8#10#10#11#15#9#17
  +#20#0#0#6#10#2#5#10#12#7#9#9#14#16#16#17
  +#6#6#6#6#6#6#6#7#7#7#8#8#8#8#8#8
  +#8#8#8#8#9#9#9#9#9#9#9#9#9#10#10#10
  +#10#10#10#11#11#11#11#11#11#11#11#11#11#12#12#12
  +#12#13#13#14#14#14#15#20#21#22#0#5#5#6#6#6
  +#6#6#6#6#7#7#7#7#7#7#7#7#7#7#7#7
  +#7#7#7#7#7#7#7#7#7#7#7#8#8#8#8#8
  +#8#8#8#8#8#8#8#8#8#8#8#8#8#8#9#9
  +#9#9#9#9#9#9#9#9#9#9#9#9#9#9#9#9
  +#9#9#9#9#9#9#9#9#9#9#9#9#9#10#10#10
  +#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10
  +#10#11#11#11#11#11#11#11#11#11#11#11#11#11#11#11
  +#11#11#11#11#11#11#11#11#11#11#11#12#12#12#12#12
  +#12#12#12#12#12#12#12#12#12#12#12#12#12#13#13#13
  +#13#13#13#13#13#13#13#13#13#13#13#13#13#14#14#14
  +#14#14#14#14#14#14#14#14#15#15#15#15#15#15#15#15
  +#15#16#16#16#16#16#16#16#16#16#17#17#17#17#17#18
  +#19#19#19#20#20#22#0#9#6#7#9#9#10#10#11#0
  +#6#7#13#0#6#7#8#8#8#8#9#9#9#10#10#10
  +#11#11#11#11#11#11#11#11#11#11#11#11#12#12#12#12
  +#12#12#12#12#12#12#13#13#13#13#13#13#13#13#14#14
  +#14#14#14#15#15#15#15#16#16#16#17#17#19#23#25#3
  +#7#8#12#5#5#5#5#5#5#6#6#6#7#7#7#7
  +#7#7#7#7#7#7#7#8#8#8#8#8#8#8#8#8
  +#8#8#9#9#9#9#9#9#9#9#9#9#9#9#9#9
  +#9#9#9#9#9#9#9#9#9#9#10#10#10#10#10#10
  +#10#10#10#10#10#11#11#11#11#11#11#11#11#11#11#11
  +#11#11#11#11#11#11#11#11#12#12#12#12#12#12#12#12
  +#12#12#12#12#12#12#12#12#12#13#13#13#13#13#13#13
  +#13#13#13#13#13#13#13#13#13#13#13#13#13#13#14#14
  +#14#14#14#14#14#14#14#15#15#15#15#15#15#15#15#15
  +#15#15#16#16#16#16#16#16#17#17#19#25#0#6#6#7
  +#7#8#9#10#11#11#16#7#8#8#8#10#11#11#11#12
  +#14#14#15#15#6#6#7#7#7#7#7#7#7#7#7#8
  +#8#8#8#8#8#8#8#8#8#9#9#9#9#10#10#11
  +#11#11#11#11#11#11#12#12#12#12#12#12#12#12#12#12
  +#13#13#13#14#15#15#17#17#19#3#7#8#9#9#9#10
  +#11#11#12#13#15#16#24#0#0#5#6#6#6#7#7#8
  +#8#8#9#9#9#9#10#10#10#10#10#10#10#11#11#11
  +#11#11#11#11#12#12#12#12#12#12#14#14#15#15#16#17
  +#20#6#14#12#14#0#0#6#7#7#7#7#7#8#9#10
  +#10#11#12#12#13#13#14#15#15#25#5#7#7#8#9#9
  +#11#11#11#11#12#13#14#15#16#16#17#0#5#6#6#7
  +#7#7#7#7#7#7#7#7#7#7#8#8#8#8#8#8
  +#8#8#8#8#8#9#9#9#9#9#9#9#10#10#10#10
  +#10#10#10#10#11#11#11#11#11#11#11#11#12#12#12#12
  +#12#12#12#13#13#14#15#15#15#16#16#18#8#17#4#6
  +#7#7#7#7#9#9#10#10#10#11#11#11#11#11#11#12
  +#12#13#13#13#14#0#4#8#0#6#6#6#7#7#7#7
  +#7#7#7#7#7#7#7#7#8#8#8#8#8#8#8#8
  +#8#8#8#8#8#8#8#8#9#9#9#9#9#9#9#9
  +#9#9#9#9#9#9#9#9#9#9#10#10#10#10#10#10
  +#10#10#10#10#10#11#11#11#11#11#11#11#11#11#11#11
  +#11#11#11#11#12#12#12#12#12#12#12#12#12#12#12#12
  +#13#13#13#13#13#13#13#13#13#13#13#13#13#13#13#13
  +#13#14#14#14#14#14#14#14#14#14#14#14#14#14#14#15
  +#15#15#15#15#15#16#16#16#16#16#16#17#17#17#17#17
  +#19#19#19#20#20#21#24#0#5#8#8#9#10#12#13#14
  +#14#15#16#16#17#17#0#7#7#8#8#8#8#8#8#8
  +#9#9#10#10#10#10#10#10#11#11#11#11#12#12#12#12
  +#13#13#13#13#15#15#16#16#17#17#18#0#11#9#12#5
  +#9#10#10#12#14#15#21#8#8#9#11#12#22#0#6#6
  +#7#7#7#7#7#7#7#7#7#7#8#8#8#8#9#9
  +#9#9#9#9#9#10#10#10#10#10#10#10#10#11#11#11
  +#11#11#11#11#12#12#12#12#13#13#13#13#13#13#14#14
  +#14#14#14#14#14#15#16#16#17#17#20#5#9#7#8#12
  +#3#3#8#8#8#8#8#8#8#8#9#9#9#10#11#11
  +#11#11#12#12#13#13#13#14#14#15#19#20#0#6#6#6
  +#6#6#7#7#7#8#8#8#8#8#8#8#9#9#9#10
  +#10#10#11#11#11#11#11#11#11#11#11#11#11#12#12#12
  +#12#12#12#12#12#12#12#13#13#13#13#13#13#13#13#14
  +#14#14#14#14#15#15#15#16#16#16#16#19#3#15#3#8
  +#10#6#6#8#8#8#9#9#9#9#9#9#9#9#10#10
  +#10#10#10#10#10#10#10#11#12#12#12#12#12#12#12#12
  +#12#12#13#13#13#13#13#14#14#15#15#15#15#15#15#15
  +#16#17#17#17#18#20#19#13#13#14#7#7#7#7#7#8
  +#8#8#8#8#8#8#8#8#8#8#8#8#9#9#9#9
  +#9#9#9#9#9#9#9#9#9#9#9#9#9#9#9#10
  +#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10
  +#10#10#11#11#11#11#11#11#11#12#12#12#12#12#12#12
  +#12#12#12#12#12#13#13#13#13#13#13#13#13#13#13#13
  +#13#13#13#13#13#13#13#13#14#14#14#14#14#14#14#14
  +#14#14#14#14#14#15#15#15#15#15#15#15#14#16#16#16
  +#16#16#16#16#16#16#16#16#17#17#17#17#18#13#14#8
  +#9#9#9#11#11#11#12#12#14#16#7#8#9#9#9#9
  +#9#9#9#9#9#10#10#10#10#11#12#12#12#12#13#15
  +#16#10#5#8#11#12#12#13#13#13#14#14#8#9#12#16
  +#16#17#4#6#6#7#8#8#8#8#8#8#8#9#9#9
  +#9#9#9#10#10#10#10#10#10#11#11#12#13#13#14#14
  +#16#18#18#20#21#9#9#9#9#10#10#10#10#11#11#11
  +#12#12#14#9#10#11#12#13#14#15#15#9#16#6#8#9
  +#11#11#12#12#12#13#14#10#11#12#14#17#10#10#12#12
  +#12#13#16#16#16#22#5#6#7#7#9#10#10#11#13#0
  +#11#13#12#13#15#9#15#6#7#7#7#8#8#8#8#8
  +#8#8#8#9#9#9#9#9#9#9#9#9#9#9#9#9
  +#10#10#10#10#10#10#10#10#10#11#11#11#11#11#11#12
  +#12#12#12#12#12#12#13#13#13#13#13#13#13#13#14#14
  +#14#15#15#16#17#17#17#17#17#16#7#11#12#13#13#16
  +#9#9#12#13#16#16#4#13#13#17#12#15#16#8#10#10
  +#10#11#11#13#14#7#8#8#8#9#9#9#9#9#10#10
  +#11#11#11#12#12#13#13#13#13#13#13#13#13#14#15#15
  +#15#15#16#16#16#18#21#30#0#11#13#16#8#8#9#11
  +#12#0#7#8#8#9#9#9#9#9#9#9#10#10#12#12
  +#13#14#16#21#7#7#9#10#10#10#10#10#10#11#13#13
  +#14#16#16#17#17#25#0#6#8#9#12#7#8#8#9#9
  +#9#9#9#9#9#10#10#10#10#10#10#10#10#10#10#11
  +#11#11#11#11#11#11#11#12#13#13#13#13#13#14#14#14
  +#14#14#15#15#15#16#16#17#17#18#19#18#21#11#12#17
  +#19#8#9#9#9#9#9#10#10#10#11#11#11#11#12#12
  +#12#12#13#13#13#13#14#14#14#14#15#15#16#16#16#17
  +#18#7#8#9#9#9#10#12#13#17#9#10#10#12#13#14
  +#14#16#17#17#10#16#23#0#6#6#7#7#7#8#8#8
  +#8#8#8#9#9#9#9#9#9#9#9#9#9#10#10#10
  +#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10
  +#11#11#11#11#11#11#11#11#11#11#11#11#11#11#11#11
  +#11#11#11#11#11#11#11#11#11#11#12#12#12#12#12#12
  +#12#12#12#12#12#12#12#12#12#12#12#13#13#13#13#13
  +#13#13#13#13#13#13#13#14#14#14#14#14#14#14#14#14
  +#14#14#14#15#15#15#15#15#15#15#15#16#16#16#16#16
  +#16#16#16#17#17#17#17#17#17#17#17#17#17#18#18#18
  +#19#20#14#9#12#13#9#9#10#10#11#12#12#12#13#13
  +#15#15#16#17#18#22#9#11#12#13#17#10#11#7#7#8
  +#9#9#10#10#10#10#10#10#11#11#11#11#11#12#12#12
  +#12#12#12#13#13#13#13#13#14#14#14#14#14#15#15#16
  +#16#16#17#17#17#17#19#18#22#0#7#7#8#8#9#9
  +#10#10#10#10#10#10#10#10#11#11#12#12#12#12#12#12
  +#13#13#13#13#13#13#13#14#14#14#14#14#14#14#15#15
  +#15#15#16#16#16#16#16#16#16#16#17#18#18#18#18#21
  +#23#11#12#8#8#9#9#10#11#13#13#14#14#14#15#0
  +#8#9#9#9#9#10#11#11#11#11#12#12#12#12#13#13
  +#13#13#13#13#14#14#14#14#14#15#15#16#17#19#24#5
  +#9#11#12#9#6#9#10#11#12#13#14#15#15#16#16#22
  +#12#8#11#11#11#12#15#16#12#9#10#10#12#12#12#12
  +#13#15#15#16#16#16#18#20#21#0#10#7#8#9#9#9
  +#9#10#10#10#10#10#10#10#10#10#10#11#11#11#11#11
  +#11#11#11#11#11#11#12#12#12#12#12#12#12#12#12#12
  +#12#12#13#13#13#13#13#13#13#13#14#14#14#14#14#14
  +#14#14#14#14#14#14#14#14#15#15#15#15#15#15#15#15
  +#15#15#15#15#15#15#16#16#16#16#16#16#16#16#16#16
  +#17#17#17#17#17#17#17#17#17#17#17#18#18#18#18#19
  +#19#19#19#20#21#24#26#6#14#17#17#10#8#9#9#9
  +#10#10#10#10#10#11#11#11#11#11#11#11#11#11#11#11
  +#11#12#12#12#12#12#12#13#13#13#13#13#13#14#14#14
  +#14#14#14#14#14#14#14#14#14#15#15#15#15#16#16#16
  +#16#16#17#17#17#17#17#17#18#18#18#19#19#19#8#9
  +#11#12#10#10#9#9#9#10#10#10#10#11#11#11#11#12
  +#13#13#14#15#17#18#19#10#10#11#13#13#19#11#11#13
  +#15#15#16#9#10#10#11#11#12#12#13#14#14#14#15#15
  +#15#15#15#16#18#6#14#9#11#12#14#14#15#15#16#17
  +#6#12#14#14#17#25#11#19#9#12#13#13#23#11#15#10
  +#11#9#10#10#10#12#12#12#13#13#13#14#14#14#14#14
  +#15#15#16#16#16#17#17#18#19#19#19#20#20#21#7#16
  +#10#13#14#18#18#10#10#11#11#11#12#12#12#12#12#12
  +#12#12#13#13#13#13#13#13#13#14#14#15#15#15#15#15
  +#15#15#15#16#16#16#16#16#16#16#16#17#17#17#19#19
  +#19#19#19#20#21#22#22#23#24#7#12#13#13#17#17#11
  +#11#12#12#13#13#14#15#13#18#12#11#12#12#14#14#15
  +#16#16#19#19#20#22#10#13#13#13#14#14#15#15#17#8
  +#12#20#8#10#10#13#14#18#18#14#14#15#16#17#18#18
  +#21#24#12#12#13#13#13#13#13#13#13#13#14#14#14#14
  +#14#14#14#14#15#15#15#15#15#15#15#15#15#15#16#16
  +#16#16#16#16#16#16#16#16#16#16#17#17#17#17#17#17
  +#17#17#18#18#18#18#18#19#19#19#19#19#19#20#20#20
  +#21#14#14#15#15#16#18#18#18#19#19#13#13#14#14#14
  +#15#15#17#17#18#18#19#19#22#14#14#15#16#16#17#19
  +#12#15#18#22#22#10#13#14#15#15#16#16#16#18#19#20
  +#23#25#14#15#17#13#16#16#17#19#19#21#23#17#17#17
  +#18#18#19#20#20#20#20#21#17#18#20#23#23#16#17#23;                               

var
        no:integer;
        BiHua:integer;
        str:string; // str[40]
        BiHuaI:integer;
        ch1:char;
        ch2:char;
        len:integer;
begin
        str:=chnstr;
        BiHuaI:=1;
        BiHua:=0;
        len:=length(str);
        while BiHuaI<=len do
        begin
                ch1:=str[BiHuaI];
                BiHuaI:=BiHuaI+1;
                if (ord(ch1)>=176) and (BiHuaI<=len) then
                begin
                        ch2:=str[BiHuaI];
                        //BiHuaI:=BiHuaI+1; ----这一行在只查一个汉字的时候用不着 2002.10
                        no:=(ord(ch1)-176)*94+(ord(ch2)-160);
                        BiHua:=ord(BiHuaTable[no]);
                end else
                begin
                        BiHua:=0;
                end;
                break; // 只要查出第一个汉字即可
        end;
        result:=BiHua;
end;

end.