delphi常用自定义函数3

{函数库说明:此函数是为提高编程效率,减少代码重用所收集的
调用方法:GC.函数名,例如:GC.KIT_DBG_TO_FILE(…)
VERSION:1.01}
unit Kitlib;
interface

uses
comobj, IniFiles, Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
Menus, StdCtrls, Db, Grids, DBGrids, ComCtrls, ExtCtrls, dbtables, NMSMTP, Graphics, Types;

type
TGCFP = class(TCOMPONENT)
procedure KIT_DBG_TO_FILE(SRC_DBE: TDATASET; FHEAD: string);
{功能:把DBGRID中的数据存入CSV或TXT文档;
参数说明 SRC_DBG:要转出的DBGRID SRC_DBE:对应的DATASET SRC_TYPE:要存成的文档类型(‘CSV’或’TXT’) }

procedure KIT_QRY_TO_FILE(SRC_DBE: TQUERY; FHEAD, FNAME: string);
{功能:把QUERY中的数据存入CSV或TXT文档; }

procedure KIT_DBGRID_TO_EXCEL(SRC_DBG: TDBGRID);
{功能:把DBGRID中的数据存入EXCEL文档;
参数说明 SRC_DBG:要转出的DBGRID}

procedure KIT_COPY_TO_NEWROW(SRC_DBG: TDBGRID);
{功能:把DBGRID中的一条记录拷贝成新记录;
参数说明 SRC_DBG:要处理的DBGRID}

procedure KIT_SORT_DBGRID(SRC_QRY: TQUERY; FLD_NAME, SORT_TYPE: string);
{功能:对DBGRID中的某一栏位进行排序;
参数说明 SRC_QRY:排序语句所在QUERY FLD_NAME:要排序的栏位 SORT_TYPE:排序类型(‘ASC’,’DESC’)}

function KIT_GET_DBSYSDATE(DBNAME: string): TDATETIME;
{功能:取得数据库端当前时间;
参数说明 DBNAME:DATABASE控件的DATABASENAME属性}

function KIT_CASH_SMALL_TO_BIG(AMOUNT: string): string;
function KIT_GET_PLACE(SRC_STR: string; SRC_PLACE: INTEGER; SRC_GLBSTR: string): string;
function KIT_GET_BIGNUM(SRC_STR1: string; SRC_PLACE: INTEGER; SRC_STR2: string): string;
function KIT_GET_BIGDEC(SRC_PLACE: INTEGER; SRC_STR: string): string;
{功能:以上四个函数可实现小写金额转大写金额,函数KIT_CASH_SMALL_TO_BIG为主函数,其它三个函数为子函数
功能由主函数调用子函数来实现;
参数说明 使用该功能隻需调用主函数KIT_CASH_SMALL_TO_BIG,参数AMOUNT为小写金额,类型为STRING}

function KIT_CASH_SMALL_TO_BIG1(AMOUNT, UNIT1, CURRENCY1: string): string;
function KIT_GET_PLACE1(SRC_STR: string; SRC_PLACE: INTEGER; SRC_GLBSTR, UNIT2, CURRENCY2: string): string;
function KIT_GET_BIGNUM1(SRC_STR1: string; SRC_PLACE: INTEGER; SRC_STR2, UNIT3, CURRENCY3: string): string;
function KIT_GET_BIGDEC1(SRC_PLACE: INTEGER; SRC_STR: string): string;
{功能:以上四个函数可实现小写金额转大写金额,函数KIT_CASH_SMALL_TO_BIG为主函数,其它三个函数为子函数
功能由主函数调用子函数来实现,可以传单位(如:万,亿),货币种类(如:元,美元,英镑等);
参数说明 使用该功能隻需调用主函数KIT_CASH_SMALL_TO_BIG,参数AMOUNT为小写金额,类型为STRING
UNIT1参数可以传单位(如:万,亿),CURRENTCY1参数可以传货币种类(如:元,美元,英镑等)}

procedure KIT_IMPORT_FROM_EXCEL(SRC_DBE: TDATASET);
{功能:把EXCEL文件导入数据库中;
参数说明 SRC_DBE:要导入的表对应的QUERY}

procedure KIT_IMPORT_FROM_TXT(SRC_DBE: TDATASET);
{功能:把TXT,CSV文件导入数据库中(TXT文件需是以逗点分隔;
参数说明 SRC_DBE:要导入的表对应的QUERY}

function KIT_DECRYPT(PASSWORD_STR: string): string;
{功能:字符串解密
参数说明 PASSWORD_STR:要解密的字符串}

function KIT_ENCRYPT(PASSWORD_STR: string): string;
{功能:字符串加密
参数说明 PASSWORD_STR:要加密的字符串}

procedure KIT_CONNECT_DB(NET_DIR: string; DB_NAME: TDATABASE; DB_DATABASENAME: string);
{功能:依据DBLOGIN.INI文件连接数据库
参数说明 NET_DIR:DBLOGIN.INI位于的网络路径(例如://VM/VMORA$/MIS/MAIN_C/DBLOGIN.INI)
DB_NAME:DATABASE控件名 DB_DATABASENAME:DATABASE控件的DATABASENAME名}

procedure KIT_CALL_EXTERNAL_EXE(EXE_DIR: string);
{功能:执行外部程序
参数说明 EXE_DIR:外部程序路径(例如:D:/DOCUMENT/TEST.EXE)}

procedure KIT_OPEN_SINGLE_PROC(SRC_APP: PCHAR);
{功能:确保同一个应用程序在一台客户端隻运行一个进程
参数说明 SRC_APP:应用程序名(此处应用程序名不包括后缀,例如:MAIN.EXE文件,应传入的参数为:MAIN)}

procedure KIT_ENTER_REPLACE_TAB(SRC_CUSTFORM: TCustomForm; SRC_KEY: CHAR);
{功能:在DBGRID中用ENTER键代替TAB键
参数说明 SRC_CUSTFORM:DBGRID所在的FORM名 SRC_KEY:KEYPRESS事件中的KEY}

procedure KIT_EXEC_IUD_SQL(SQL_TXT: string; SRC_FORM: TFORM);
{功能:执行INSERT,UPDATE,DELETE语句
参数说明 SQL_TXT:SQL语句 SRC_FORM:(当前激活窗口,可以是SELF)}

procedure KIT_Open_Child_Form(FormClass: TFormClass; var Fm; AOwner: TComponent);
{功能:子窗体如存在则激活,不存在则创建
参数说明 FormClass:表示一窗体类 Fm:窗体名 AOwner:宿主(一般为SELF)}

procedure KIT_SEARCH_IN_DBGRID(SRC_DBG: TDBGRID);
{功能:在DBGRID中查找字符串
参数说明 SRC_DBG:表示需要查找的DBGRID}

procedure KIT_SENDMAIL_SMTP(FILPATH: string);
{功能:从INI文件中选取信息,根据相关信息发送邮件
参数说明 FILPATH:表示INI文件路径}

{CHARSET=US-ASCII;
HOST=KS-CIRCUITECH;主机名
PORT=25;端口号
[POSTMSG]
ATT=NONE
(ATT指的是附件,无附件写NONE,从ini文件中读数据用LOADFROMTHIS,从其它文件中读数据用FILES)
ATTMSG=
(当ATT=LOADFROMTHIS时,ATTMSG=附件的个数,当ATT=FILES时,ATTMSG=存有附件的文件路径)
ATT1=
ATT2=
BODY=LOADFROMTHIS
(BODY指的是邮件的正文,用法同ATT)
BODYMSG=2
BODY1=TEST
BODY2=LAST TEST
DATE=2002/12/12
FROMADD=kk@KS-CIRCUITECH.COM
FROMNAME=中国人
SUBJECT=a test
TOADD=LOADFROMTHIS
(收件人列表,用法同ATT)
TOADDMSG=2
TOADD1=SLADE@KS-CIRCUITECH.COM
TOADD2=TITAN@KS-CIRCUITECH.COM
}
procedure OpenChildForm(FormClass: TFormClass; var Fm; AOwner: TComponent);
// 临时创建窗体时查找要建的窗体有没存在，如有则SHOw反之创建

procedure PRO_INPUT_NUM_ONLY(var Key: Char; IS_INPUT_POINT: string; TEXT: string);
{功能:限制隻能输入数字和BackSpace，IS_INPUT_POINT为’Y’则可以输入小数点,’N’则不可以输入小数点}
procedure PRO_CANVAS_COLOR(SRC_DBG: TDBGRID; Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
{功能:dbgrid 隔行画颜色20070629 wjl,qry中一定要有rownum栏位}
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
{功能:dbgrid实实现中键可以滚动功能20070629 wjl}
private

{ Private declarations }
public

{ Public declarations }
end;

var
GC: TGCFP; {全局单元}
DATASET_NAME, LAST_STR: string;
J: INTEGER;

implementation

procedure TGCFP.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var hWnd: THandle; aName: array[0..255] of char;
begin
if Msg.message <> WM_MOUSEWHEEL then exit;
hWnd := WindowFromPoint(msg.pt);
if boolean(GetClassName(hWnd, aName, 256)) and (aName = ‘TDBGrid’) then //如果第三方控件需要修改，比如用aName=’TbsSkinDBGrid’
begin
if Short(HIWORD(Msg.wParam)) < 0 then begin PostMessage(hWnd, WM_KEYDOWN, VK_DOWN, 0); PostMessage(hWnd, WM_KEYUP, VK_DOWN, 0) end else begin PostMessage(hWnd, WM_KEYDOWN, VK_UP, 0); PostMessage(hWnd, WM_KEYUP, VK_UP, 0); end; end; end; procedure TGCFP.PRO_CANVAS_COLOR(SRC_DBG: TDBGRID; Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); begin if SRC_DBG.DataSource.DataSet.FieldByName('ROWNUM').AsInteger mod 2 <> 0 then
SRC_DBG.Canvas.brush.Color := clSilver
else
SRC_DBG.Canvas.brush.Color := clMoneyGreen;
SRC_DBG.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

procedure TGCFP.PRO_INPUT_NUM_ONLY(var Key: Char; IS_INPUT_POINT: string; TEXT: string);
begin
if IS_INPUT_POINT = ‘N’ then
if (KEY in [‘0’..’9′, #8]) then
if (LENGTH(TEXT) = 0) and (KEY = ‘0’) then
KEY := #0
else
KEY := KEY
else
KEY := #0;
if IS_INPUT_POINT = ‘Y’ then
if (key in [‘0’..’9′, ‘.’, #8]) then
begin
if (LENGTH(TEXT) = 0) and (KEY = ‘.’) then
KEY := #0;
if (TEXT = ‘0’) then
begin
if (KEY = ‘.’) or (KEY = #8) then
begin
KEY := KEY;
EXIT;
end
else
begin
KEY := #0;
EXIT;
end;
end;
if (POS(‘.’, TEXT) > 0) and (KEY = ‘.’) then
KEY := #0;
if KEY <> #0 then
KEY := KEY;
end
else
key := #0;
end;

procedure TGCFP.OpenChildForm(FormClass: TFormClass; var Fm; AOwner: TComponent);
var Child: tform;
i: integer;
begin
for i := 0 to Screen.FormCount – 1 do
if Screen.Forms[i].ClassType = FormClass then
begin
Child := Screen.Forms[i];
if ((Child.WindowState = wsMaximized) or
(Child.WindowState = wsNormal)) then
Child.BringToFront
else
begin
child.Visible := true;
Child.WindowState := wsNormal;
Child.BringToFront;
end;
exit;
end;
Child := TForm(FormClass.NewInstance);
TForm(fm) := Child;
Child.Create(AOwner);
end;

procedure TGCFP.KIT_QRY_TO_FILE(SRC_DBE: TQUERY; FHEAD, FNAME: string);
var
LINE_TXT: string;
I: INTEGER;
FWRITETO: TEXTFILE;
begin
LINE_TXT := ”;
ASSIGNFILE(FWRITETO, FNAME);
REWRITE(FWRITETO);
LINE_TXT := FHEAD;
WRITELN(FWRITETO, LINE_TXT);
FLUSH(FWRITETO);
with SRC_DBE do
begin
FIRST;
while not EOF do
begin
LINE_TXT := ”;
for I := 0 to SRC_DBE.FIELDDEFS.COUNT – 1 do
LINE_TXT := LINE_TXT + ‘”‘ + TRIM(FIELDBYNAME(SRC_DBE.FieldDefs.Items[I].name).ASSTRING) + ‘”‘ + ‘,’;
WRITELN(FWRITETO, LINE_TXT);
FLUSH(FWRITETO);
NEXT;
end;
end;
CLOSEFILE(FWRITETO);
end;

procedure TGCFP.KIT_DBG_TO_FILE(SRC_DBE: TDATASET; FHEAD: string);
var
LINE_TXT: string;
I: INTEGER;
FWRITETO: TEXTFILE;
SAVEDIALOG1: TSAVEDIALOG;
FNAME: string;
begin
SAVEDIALOG1 := TSAVEDIALOG.CREATE(SELF);
if SAVEDIALOG1.Execute then
begin
FNAME := SAVEDIALOG1.FileName;
if ((FNAME[LENGTH(FNAME)] = ‘V’) or (FNAME[LENGTH(FNAME)] = ‘v’)) and ((FNAME[LENGTH(FNAME) – 1] = ‘s’) or (FNAME[LENGTH(FNAME) – 1] = ‘S’))
and ((FNAME[LENGTH(FNAME) – 2] = ‘c’) or (FNAME[LENGTH(FNAME) – 2] = ‘C’)) and (FNAME[LENGTH(FNAME) – 3] = ‘.’) then
FNAME := SAVEDIALOG1.FileName
else
FNAME := SAVEDIALOG1.FileName + ‘.csv’;
end;
LINE_TXT := ”;
ASSIGNFILE(FWRITETO, FNAME);
REWRITE(FWRITETO);

LINE_TXT := FHEAD;
WRITELN(FWRITETO, LINE_TXT);
FLUSH(FWRITETO);

with SRC_DBE do
begin
FIRST;
while not EOF do
begin
LINE_TXT := ”;
for I := 0 to SRC_DBE.FIELDDEFS.COUNT – 1 do
LINE_TXT := LINE_TXT + ‘”‘ + TRIM(FIELDBYNAME(SRC_DBE.FieldDefs.Items[I].name).ASSTRING) + ‘”‘ + ‘,’;
WRITELN(FWRITETO, LINE_TXT);
FLUSH(FWRITETO);
NEXT;
end;
end;
CLOSEFILE(FWRITETO);
end;

procedure TGCFP.KIT_COPY_TO_NEWROW(SRC_DBG: TDBGRID);
var
ROW_TXT: array of string;
I: INTEGER;
begin
if not SRC_DBG.DataSource.DataSet.CanModify then
EXIT;
SetLength(ROW_TXT, SRC_DBG.Columns.Count);
with SRC_DBG.DataSource.DataSet do
begin
if EOF then
begin
SHOWMESSAGE(‘当前已位于表尾!你要自己录入数据!’);
INSERT;
EXIT;
end;
for I := 0 to SRC_DBG.Columns.Count – 1 do
begin
ROW_TXT[I] := TRIM(FIELDBYNAME(SRC_DBG.Columns[I].fieldname).ASSTRING);
end;
INSERT;
for I := 0 to SRC_DBG.Columns.Count – 1 do
begin
FIELDBYNAME(SRC_DBG.Columns[I].fieldname).ASSTRING := ROW_TXT[I];
end;
end;
end;

procedure TGCFP.KIT_SORT_DBGRID(SRC_QRY: TQUERY; FLD_NAME, SORT_TYPE: string);
var
SQLTXT: string;
begin
try
SQLTXT := SRC_QRY.SQL.TEXT;
if POS(‘ ORDER BY’, SQLTXT) <> 0 then
SQLTXT := COPY(SQLTXT, 0, POS(‘ ORDER BY’, SQLTXT) – 1);
with SRC_QRY do
begin
SQLTXT := SQLTXT + ‘ ORDER BY ‘ + FLD_NAME + ‘ ‘ + SORT_TYPE;
CLOSE;
SQL.Clear;
SQL.ADD(SQLTXT);
OPEN;
end;
except
SRC_QRY.SQL.TEXT := SQLTXT;
end;
end;

function TGCFP.KIT_GET_DBSYSDATE(DBNAME: string): TDATETIME;
var
ACT_QRY: TQUERY;
SYS_DT: TDATETIME;
begin
ACT_QRY := TQUERY.CREATE(APPLICATION);
ACT_QRY.DATABASENAME := DBNAME;
ACT_QRY.SQL.TEXT := ‘SELECT SYSDATE AS SDT FROM DUAL’;
ACT_QRY.OPEN;
SYS_DT := ACT_QRY.FIELDBYNAME(‘SDT’).ASDATETIME;
KIT_GET_DBSYSDATE := SYS_DT;
ACT_QRY.FREE;
end;

{小写金额转大写金额}

function TGCFP.KIT_CASH_SMALL_TO_BIG(AMOUNT: string): string;
var
I, J, K: INTEGER;
INTSTR, DECSTR: string;
BIG1, BIG2: string;
TMPSTR1, TMPSTR2, TMPSTR3: string;
begin
INTSTR := ”;
DECSTR := ”;
BIG1 := ”;
BIG2 := ”;
TMPSTR1 := ”;
TMPSTR2 := ”;
TMPSTR3 := ”;

if TRIM(AMOUNT) = ” then
begin
SHOWMESSAGE(‘请输入小写金额!’);
EXIT;
end;

if POS(‘.’, AMOUNT) = 0 then
begin
INTSTR := AMOUNT;
I := LENGTH(INTSTR);
J := 0;
end
else
begin
INTSTR := COPY(AMOUNT, 1, (POS(‘.’, AMOUNT) – 1));
DECSTR := COPY(AMOUNT, (POS(‘.’, AMOUNT) + 1), (LENGTH(AMOUNT) – POS(‘.’, AMOUNT)));
I := LENGTH(INTSTR);
J := LENGTH(DECSTR);
end;

if (INTSTR = ‘0’) and (J = 0) then
KIT_CASH_SMALL_TO_BIG := ‘零’
else if (INTSTR <> ‘0’) and (J = 0) then
begin
for K := 1 to I do
begin
TMPSTR1 := COPY(INTSTR, I – K + 1, 1);
TMPSTR2 := GC.KIT_GET_PLACE(TMPSTR1, K, INTSTR);
if TMPSTR2 <> ‘!’ then
BIG1 := TMPSTR2 + BIG1;
TMPSTR3 := GC.KIT_GET_BIGNUM(TMPSTR1, K, BIG1);
if TMPSTR3 <> ‘!’ then
BIG1 := TMPSTR3 + BIG1;
end;
KIT_CASH_SMALL_TO_BIG := BIG1 + ‘整’;
end
else if (INTSTR = ‘0’) and (J > 0) then
begin
for K := 1 to J do
begin
TMPSTR1 := GC.KIT_GET_BIGDEC(K, COPY(DECSTR, K – 1 + 1, 1));
if TMPSTR1 <> ‘!’ then
BIG2 := BIG2 + TMPSTR1;
end;
KIT_CASH_SMALL_TO_BIG := BIG2;
end
else if (INTSTR <> ‘0’) and (J > 0) then
begin
for K := 1 to I do
begin
TMPSTR1 := COPY(INTSTR, I – K + 1, 1);
TMPSTR2 := GC.KIT_GET_PLACE(TMPSTR1, K, INTSTR);
if TMPSTR2 <> ‘!’ then
BIG1 := TMPSTR2 + BIG1;
TMPSTR3 := GC.KIT_GET_BIGNUM(TMPSTR1, K, BIG1);
if TMPSTR3 <> ‘!’ then
BIG1 := TMPSTR3 + BIG1;
end;
for K := 1 to J do
begin
TMPSTR1 := GC.KIT_GET_BIGDEC(K, COPY(DECSTR, K – 1 + 1, 1));
if TMPSTR1 <> ‘!’ then
BIG2 := BIG2 + TMPSTR1;
end;
KIT_CASH_SMALL_TO_BIG := BIG1 + BIG2;
end;
end;

function TGCFP.KIT_GET_PLACE(SRC_STR: string; SRC_PLACE: INTEGER; SRC_GLBSTR: string): string;
var
I: INTEGER;
TMPSTR: string;
begin
TMPSTR := ”;
I := LENGTH(SRC_GLBSTR);
if I > 8 then
TMPSTR := COPY(SRC_GLBSTR, I – 8 + 1, 4);
if SRC_PLACE = 1 then
KIT_GET_PLACE := ‘元’
else if SRC_PLACE = 5 then
if TMPSTR = ‘0000’ then
KIT_GET_PLACE := ‘!’
else
KIT_GET_PLACE := ‘万’
else if SRC_PLACE = 9 then
KIT_GET_PLACE := ‘亿’
else if (SRC_STR = ‘0’) and (SRC_PLACE <> 1) and (SRC_PLACE <> 5) then
KIT_GET_PLACE := ‘!’
else if (SRC_STR <> ‘0’) and (SRC_PLACE > 1) and (SRC_PLACE <> 5) then
case SRC_PLACE of
2, 6, 10: KIT_GET_PLACE := ‘拾’;
3, 7, 11: KIT_GET_PLACE := ‘佰’;
4, 8, 12: KIT_GET_PLACE := ‘千’;
end;
end;

function TGCFP.KIT_GET_BIGNUM(SRC_STR1: string; SRC_PLACE: INTEGER; SRC_STR2: string): string;
var
TMPSTR: string;
begin
case STRTOINT(SRC_STR1) of
1: TMPSTR := ‘一’;
2: TMPSTR := ‘贰’;
3: TMPSTR := ‘参’;
4: TMPSTR := ‘肆’;
5: TMPSTR := ‘伍’;
6: TMPSTR := ‘陆’;
7: TMPSTR := ‘柒’;
8: TMPSTR := ‘捌’;
9: TMPSTR := ‘玖’;
end;
if SRC_STR1 = ‘0’ then
if (COPY(SRC_STR2, 0, 2) = ‘零’) or (COPY(SRC_STR2, 0, 2) = ‘元’) or (COPY(SRC_STR2, 0, 2) = ‘万’) or (COPY(SRC_STR2, 0, 2) = ‘亿’) then
TMPSTR := ‘!’
else
TMPSTR := ‘零’;

KIT_GET_BIGNUM := TMPSTR;
end;

function TGCFP.KIT_GET_BIGDEC(SRC_PLACE: INTEGER; SRC_STR: string): string;
var
TMPSTR: string;
begin
case STRTOINT(SRC_STR) of
1: TMPSTR := ‘一’;
2: TMPSTR := ‘贰’;
3: TMPSTR := ‘参’;
4: TMPSTR := ‘肆’;
5: TMPSTR := ‘伍’;
6: TMPSTR := ‘陆’;
7: TMPSTR := ‘柒’;
8: TMPSTR := ‘捌’;
9: TMPSTR := ‘玖’;
end;

if SRC_STR = ‘0’ then
TMPSTR := ‘!’
else if SRC_STR <> ‘0’ then
if SRC_PLACE = 1 then
TMPSTR := TMPSTR + ‘角’
else if SRC_PLACE = 2 then
TMPSTR := TMPSTR + ‘分’
else if SRC_PLACE = 3 then
TMPSTR := TMPSTR + ‘厘’;

KIT_GET_BIGDEC := TMPSTR;
end;
{小写金额转大写金额}

{小写金额转大写金额升级版}

function TGCFP.KIT_CASH_SMALL_TO_BIG1(AMOUNT, UNIT1, CURRENCY1: string): string;
var
I, J, K: INTEGER;
INTSTR, DECSTR: string;
BIG1, BIG2: string;
TMPSTR1, TMPSTR2, TMPSTR3: string;
begin
INTSTR := ”;
DECSTR := ”;
BIG1 := ”;
BIG2 := ”;
TMPSTR1 := ”;
TMPSTR2 := ”;
TMPSTR3 := ”;

if TRIM(AMOUNT) = ” then
begin
SHOWMESSAGE(‘请输入小写金额!’);
EXIT;
end;

if POS(‘.’, AMOUNT) = 0 then
begin
INTSTR := AMOUNT;
I := LENGTH(INTSTR);
J := 0;
end
else
begin
INTSTR := COPY(AMOUNT, 1, (POS(‘.’, AMOUNT) – 1));
DECSTR := COPY(AMOUNT, (POS(‘.’, AMOUNT) + 1), (LENGTH(AMOUNT) – POS(‘.’, AMOUNT)));
I := LENGTH(INTSTR);
J := LENGTH(DECSTR);
end;

if (INTSTR = ‘0’) and (J = 0) then
KIT_CASH_SMALL_TO_BIG1 := ‘零’
else if (INTSTR <> ‘0’) and (J = 0) then
begin
for K := 1 to I do
begin
TMPSTR1 := COPY(INTSTR, I – K + 1, 1);
TMPSTR2 := GC.KIT_GET_PLACE1(TMPSTR1, K, INTSTR, UNIT1, CURRENCY1);
if TMPSTR2 <> ‘!’ then
BIG1 := TMPSTR2 + BIG1;
TMPSTR3 := GC.KIT_GET_BIGNUM1(TMPSTR1, K, BIG1, UNIT1, CURRENCY1);
if TMPSTR3 <> ‘!’ then
BIG1 := TMPSTR3 + BIG1;
end;
KIT_CASH_SMALL_TO_BIG1 := BIG1 + ‘整’;
end
else if (INTSTR = ‘0’) and (J > 0) then
begin
for K := 1 to J do
begin
TMPSTR1 := GC.KIT_GET_BIGDEC1(K, COPY(DECSTR, K – 1 + 1, 1));
if TMPSTR1 <> ‘!’ then
BIG2 := BIG2 + TMPSTR1;
end;
KIT_CASH_SMALL_TO_BIG1 := BIG2;
end
else if (INTSTR <> ‘0’) and (J > 0) then
begin
for K := 1 to I do
begin
TMPSTR1 := COPY(INTSTR, I – K + 1, 1);
TMPSTR2 := GC.KIT_GET_PLACE1(TMPSTR1, K, INTSTR, UNIT1, CURRENCY1);
if TMPSTR2 <> ‘!’ then
BIG1 := TMPSTR2 + BIG1;
TMPSTR3 := GC.KIT_GET_BIGNUM1(TMPSTR1, K, BIG1, UNIT1, CURRENCY1);
if TMPSTR3 <> ‘!’ then
BIG1 := TMPSTR3 + BIG1;
end;
for K := 1 to J do
begin
TMPSTR1 := GC.KIT_GET_BIGDEC1(K, COPY(DECSTR, K – 1 + 1, 1));
if TMPSTR1 <> ‘!’ then
BIG2 := BIG2 + TMPSTR1;
end;
KIT_CASH_SMALL_TO_BIG1 := BIG1 + BIG2;
end;
end;

function TGCFP.KIT_GET_PLACE1(SRC_STR: string; SRC_PLACE: INTEGER; SRC_GLBSTR, UNIT2, CURRENCY2: string): string;
var
I: INTEGER;
TMPSTR: string;
begin
TMPSTR := ”;
I := LENGTH(SRC_GLBSTR);
if I > 8 then
TMPSTR := COPY(SRC_GLBSTR, I – 8 + 1, 4);
if SRC_PLACE = 1 then
KIT_GET_PLACE1 := UNIT2 + CURRENCY2
else if SRC_PLACE = 5 then
if TMPSTR = ‘0000’ then
KIT_GET_PLACE1 := ‘!’
else
KIT_GET_PLACE1 := ‘万’
else if SRC_PLACE = 9 then
KIT_GET_PLACE1 := ‘亿’
else if (SRC_STR = ‘0’) and (SRC_PLACE <> 1) and (SRC_PLACE <> 5) then
KIT_GET_PLACE1 := ‘!’
else if (SRC_STR <> ‘0’) and (SRC_PLACE > 1) and (SRC_PLACE <> 5) then
case SRC_PLACE of
2, 6, 10: KIT_GET_PLACE1 := ‘拾’;
3, 7, 11: KIT_GET_PLACE1 := ‘佰’;
4, 8, 12: KIT_GET_PLACE1 := ‘千’;
end;
end;

function TGCFP.KIT_GET_BIGNUM1(SRC_STR1: string; SRC_PLACE: INTEGER; SRC_STR2, UNIT3, CURRENCY3: string): string;
var
TMPSTR: string;
I: INTEGER;
begin
case STRTOINT(SRC_STR1) of
1: TMPSTR := ‘一’;
2: TMPSTR := ‘贰’;
3: TMPSTR := ‘参’;
4: TMPSTR := ‘肆’;
5: TMPSTR := ‘伍’;
6: TMPSTR := ‘陆’;
7: TMPSTR := ‘柒’;
8: TMPSTR := ‘捌’;
9: TMPSTR := ‘玖’;
end;

I := LENGTH(UNIT3 + CURRENCY3);
if (SRC_STR1 = ‘0’) and (POS(‘万’, UNIT3) = 0) and (POS(‘亿’, UNIT3) = 0) then
if (COPY(SRC_STR2, 0, 2) = ‘零’) or (COPY(SRC_STR2, 0, I) = UNIT3 + CURRENCY3) or (COPY(SRC_STR2, 0, 2) = ‘万’) or (COPY(SRC_STR2, 0, 2) = ‘亿’) then
TMPSTR := ‘!’
else
TMPSTR := ‘零’;

if (SRC_STR1 = ‘0’) and (POS(‘万’, UNIT3) > 0) then
if (COPY(SRC_STR2, 0, 2) = ‘零’) or (COPY(SRC_STR2, 0, I) = UNIT3 + CURRENCY3) or (COPY(SRC_STR2, 0, 2) = ‘万’) or (COPY(SRC_STR2, 0, 4) = ‘万万’) or (COPY(SRC_STR2, 0, 2) = ‘亿’) then
TMPSTR := ‘!’
else
TMPSTR := ‘零’;

if (SRC_STR1 = ‘0’) and (POS(‘亿’, UNIT3) > 0) then
if (COPY(SRC_STR2, 0, 2) = ‘零’) or (COPY(SRC_STR2, 0, I) = UNIT3 + CURRENCY3) or (COPY(SRC_STR2, 0, 2) = ‘万’) or (COPY(SRC_STR2, 0, 2) = ‘亿’) or (COPY(SRC_STR2, 0, 4) = ‘万亿’) or (COPY(SRC_STR2, 0, 4) = ‘亿亿’) then
TMPSTR := ‘!’
else
TMPSTR := ‘零’;

KIT_GET_BIGNUM1 := TMPSTR;
end;

function TGCFP.KIT_GET_BIGDEC1(SRC_PLACE: INTEGER; SRC_STR: string): string;
var
TMPSTR: string;
begin
case STRTOINT(SRC_STR) of
1: TMPSTR := ‘一’;
2: TMPSTR := ‘贰’;
3: TMPSTR := ‘参’;
4: TMPSTR := ‘肆’;
5: TMPSTR := ‘伍’;
6: TMPSTR := ‘陆’;
7: TMPSTR := ‘柒’;
8: TMPSTR := ‘捌’;
9: TMPSTR := ‘玖’;
end;

if SRC_STR = ‘0’ then
TMPSTR := ‘!’
else if SRC_STR <> ‘0’ then
if SRC_PLACE = 1 then
TMPSTR := TMPSTR + ‘角’
else if SRC_PLACE = 2 then
TMPSTR := TMPSTR + ‘分’
else if SRC_PLACE = 3 then
TMPSTR := TMPSTR + ‘厘’;

KIT_GET_BIGDEC1 := TMPSTR;
end;
{小写金额转大写金额升级版}

procedure TGCFP.KIT_IMPORT_FROM_EXCEL(SRC_DBE: TDATASET);
var
EXCEL: VARIANT;
EXCEL_WORKBOOK: VARIANT;
EXCEL_WORKSHEET: VARIANT;
OPENDIALOG1: TOPENDIALOG;
I, J: INTEGER;
INI_DIR: string;
begin
try
if SRC_DBE.CONTROLSDISABLED then
EXIT;
if not SRC_DBE.ACTIVE then
EXIT;
if not SRC_DBE.CANMODIFY then
begin
SHOWMESSAGE(‘YOU HAVE NO WRITE PERMISSION TO THIS DBGRID, SORRY ! QUIT…..’);
EXIT;
end;
try
EXCEL := CREATEOLEOBJECT(‘EXCEL.APPLICATION’);
except
SHOWMESSAGE(‘EXCEL MAY NOT BE INSTALLED’);
ABORT;
EXIT;
end;

OPENDIALOG1 := TOPENDIALOG.CREATE(SRC_DBE);
OPENDIALOG1.DEFAULTEXT := ‘XLS’;
OPENDIALOG1.FILTER := ‘EXCEL FILE|*.XLS’;
GETDIR(0, INI_DIR);
OPENDIALOG1.INITIALDIR := INI_DIR;

if OPENDIALOG1.EXECUTE then
begin
if FILEEXISTS(OPENDIALOG1.FILENAME) then
begin
if MESSAGEDLG(‘THIS PROGRAM WILL READ FROM CELLS A1, IN THE SAME ORDER DISPLAYED IN THE DBGRID, CONTINUE?’, MTCONFIRMATION, [MBNO, MBYES], 0) = MRNO then
begin
OPENDIALOG1.FREE;
EXCEL.APPLICATION.QUIT;
EXIT;
end;
EXCEL.WORKBOOKS.OPEN(OPENDIALOG1.FILENAME);
end
else
begin
SHOWMESSAGE(‘FILE DOES NOT EXISTS, QUITING….’);
OPENDIALOG1.FREE;
EXCEL.APPLICATION.QUIT;
EXIT;
end;
end
else
begin
SHOWMESSAGE(‘未指定需要导入的文件,退出….’);
OPENDIALOG1.FREE;
EXCEL.APPLICATION.QUIT;
EXIT;
end;
EXCEL_WORKBOOK := EXCEL.APPLICATION.WORKBOOKS[1];
EXCEL_WORKSHEET := EXCEL_WORKBOOK.WORKSHEETS[1];

J := 2;
with SRC_DBE do
begin
DISABLECONTROLS;
while not ((TRIM(EXCEL_WORKSHEET.CELLS.ITEM[J, 1]) + TRIM(EXCEL_WORKSHEET.CELLS.ITEM[J, 2]) + TRIM(EXCEL_WORKSHEET.CELLS.ITEM[J, 3])) = ”) do
begin
INSERT;
for I := 0 to SRC_DBE.FIELDCOUNT – 1 do
begin
FIELDBYNAME(SRC_DBE.FIELDDEFS.ITEMS[I].NAME).ASSTRING := TRIM(EXCEL_WORKSHEET.CELLS.ITEM[J, I + 1]);
end;
J := J + 1;
end;
ENABLECONTROLS;
end;
EXCEL.APPLICATION.QUIT;
SHOWMESSAGE(‘GET DATA FROM EXCEL FILE : ‘ + OPENDIALOG1.FILENAME + ‘ SUCCESSFULLY! REMEMBER TO SAVE IT BEFORE YOU CLOSE THIS WINDOW! ‘);
OPENDIALOG1.FREE;
except
OPENDIALOG1.FREE;
if SRC_DBE.CONTROLSDISABLED then
SRC_DBE.ENABLECONTROLS;
EXCEL.APPLICATION.QUIT;
SHOWMESSAGE(‘导入失败,请确认该文件是否处于打开状态!确认将其关闭后再试一次!’);
end;
end;

procedure TGCFP.KIT_IMPORT_FROM_TXT(SRC_DBE: TDATASET);
var
LINE_TXT: string;
I, J, K: INTEGER;
LEFT_LINE_TXT: string;
INI_DIR: string;
TMP_STR: string;
QUOTE_FLAG: INTEGER;
OPENDIALOG1: TOPENDIALOG;
ERR_STR: string;
FNAME: string;
TXTFILE: TEXTFILE;
begin
LINE_TXT := ”;
TMP_STR := ”;
if SRC_DBE.CONTROLSDISABLED then EXIT;
if not ((SRC_DBE.ACTIVE) and (SRC_DBE.FIELDCOUNT > 0)) then EXIT;
if not SRC_DBE.CANMODIFY then
begin
SHOWMESSAGE(‘YOU HAVE NO WRITE PERMISSION TO THIS DATA!’);
EXIT;
end;
ERR_STR := ”;
ERR_STR := ERR_STR + ‘YOU MUST SET THE SAME ORDER FOR ALL THE COLUMNS IN THE TEXT FILE ‘ + CHR(13) + CHR(10);
ERR_STR := ERR_STR + ‘AS DISPLAYED IN THE DBGRID! ‘ + CHR(13) + CHR(10);
ERR_STR := ERR_STR + ‘OR ERROR WILL HAPPEN, AND YOU MUST DELETE IT FROM THE DBGRID ‘ + CHR(13) + CHR(10);
ERR_STR := ERR_STR + ‘AND THEN RETRY THIS ACTION.’ + CHR(13) + CHR(10);
ERR_STR := ERR_STR + ‘SURE FOR CONTINUE?…’;
if MESSAGEDLG(ERR_STR, MTCONFIRMATION, [MBYES, MBNO], 0) <> MRYES then
EXIT;

OPENDIALOG1 := TOPENDIALOG.CREATE(SRC_DBE);
try
OPENDIALOG1.DEFAULTEXT := ‘TXT’;
OPENDIALOG1.FILTER := ‘TEXT/CSV FILE|*.TXT;*.CSV’;
GETDIR(0, INI_DIR);
OPENDIALOG1.INITIALDIR := INI_DIR;

if OPENDIALOG1.EXECUTE then
FNAME := OPENDIALOG1.FILENAME
else
begin
SHOWMESSAGE(‘未指定文件名,退出….’);
OPENDIALOG1.FREE;
EXIT;
end;
if not (FILEEXISTS(FNAME)) then
begin
SHOWMESSAGE(‘所指定的文件不存在,退出….’);
OPENDIALOG1.FREE;
EXIT;
end;
try
ASSIGNFILE(TXTFILE, FNAME);
RESET(TXTFILE);
if not SRC_DBE.ACTIVE then SRC_DBE.ACTIVE := TRUE;
READLN(TXTFILE, LINE_TXT);
J := 1;
while not EOF(TXTFILE) do
begin
READLN(TXTFILE, LINE_TXT);
LEFT_LINE_TXT := TRIM(LINE_TXT);
if TRIM(LINE_TXT) = ” then CONTINUE;
with SRC_DBE do
begin
INSERT;
try
for I := 0 to SRC_DBE.FIELDDEFS.COUNT – 1 do
begin
if LEFT_LINE_TXT = ” then BREAK;
QUOTE_FLAG := POS(‘”‘, LEFT_LINE_TXT);
K := POS(‘,’, LEFT_LINE_TXT);
if (K > 0) or (QUOTE_FLAG = 1) then
begin
if LENGTH(LEFT_LINE_TXT) = 1 then
begin
LEFT_LINE_TXT := ”;
BREAK;
end;
if QUOTE_FLAG = 1 then
begin
TMP_STR := COPY(LEFT_LINE_TXT, 2, LENGTH(LEFT_LINE_TXT) – 1);
QUOTE_FLAG := POS(‘”‘, TMP_STR);
if (QUOTE_FLAG > 0) then
begin
if QUOTE_FLAG > 1 then
FIELDBYNAME(SRC_DBE.FIELDDEFS.ITEMS[I].NAME).ASSTRING := COPY(TMP_STR, 1, QUOTE_FLAG – 1);
LEFT_LINE_TXT := COPY(TMP_STR, QUOTE_FLAG + 1, LENGTH(TMP_STR) – QUOTE_FLAG);
if (LENGTH(LEFT_LINE_TXT) > 0) and (POS(‘,’, LEFT_LINE_TXT) = 1) then
LEFT_LINE_TXT := COPY(LEFT_LINE_TXT, 2, LENGTH(LEFT_LINE_TXT) – 1);
CONTINUE;
end;
end;

TMP_STR := COPY(LEFT_LINE_TXT, 1, K – 1);
if TMP_STR <> ” then
FIELDBYNAME(SRC_DBE.FIELDDEFS.ITEMS[I].NAME).ASSTRING := TMP_STR;
LEFT_LINE_TXT := COPY(LEFT_LINE_TXT, K + 1, LENGTH(LEFT_LINE_TXT) – K);

end
else
begin
FIELDBYNAME(SRC_DBE.FIELDDEFS.ITEMS[I].NAME).ASSTRING := LEFT_LINE_TXT;
LEFT_LINE_TXT := ”;
end;
end;
LINE_TXT := ”;
except
ERR_STR := ‘DATA ERROR IN LINE : ‘ + INTTOSTR(J) + ‘; ‘ + CHR(13) + CHR(10);
ERR_STR := ERR_STR + ‘ : ‘ + LINE_TXT + CHR(13) + CHR(10);
ERR_STR := ERR_STR + ‘PRESS YES TO CONTINUE, NO TO EXIT’;
DELETE;
if MESSAGEDLG(ERR_STR, MTCONFIRMATION, [MBYES, MBNO], 0) <> MRYES then
begin
OPENDIALOG1.FREE;
CLOSEFILE(TXTFILE);
EXIT;
end;
end;
J := J + 1;
end;
end;
CLOSEFILE(TXTFILE);
except
CLOSEFILE(TXTFILE);
SHOWMESSAGE(‘GET DATA FAILED!’);
EXIT;
end;
SHOWMESSAGE(‘GET DATA FROM FILE :’ + FNAME + ‘ SUCCESSFULLY! REMEMBER TO SAVE IT BEFORE YOU CLOSE THIS WINDOW!’);
OPENDIALOG1.FREE;
except
OPENDIALOG1.FREE;
SHOWMESSAGE(‘GET DATA ERROR!’);
end;
end;

function TGCFP.KIT_DECRYPT(PASSWORD_STR: string): string;
var
TMP_STR: string;
I, J, K, L, M: WORD;
begin
KIT_DECRYPT := ”;
TMP_STR := ”;
// L := 0;
M := 0;
I := LENGTH(PASSWORD_STR);
if I < 2 then EXIT; L := ORD(PASSWORD_STR[1]); L := L div 10; for J := 2 to I do begin K := ORD(PASSWORD_STR[J]); K := (K - 32 - L) div 8; M := M * 10 + K; if M >= 32 then
begin
TMP_STR := TMP_STR + CHR(M);
M := 0;
end;
end;
KIT_DECRYPT := TMP_STR;
end;

function TGCFP.KIT_ENCRYPT(PASSWORD_STR: string): string;
var
TMP_STR: string;
I, J, K, L, M: WORD;
begin
KIT_ENCRYPT := ”;
TMP_STR := ”;
DecodeTime(NOW, I, J, K, L);
L := 60 + (L div 16);
TMP_STR := CHR(L);
I := LENGTH(PASSWORD_STR);
if I < 1 then EXIT; for J := 1 to I do begin K := ORD(PASSWORD_STR[J]); if K >= 100 then
begin
M := K div 100;
TMP_STR := TMP_STR + CHR(M * 8 + 32 + (L div 10));
M := (K – (M * 100)) div 10;
TMP_STR := TMP_STR + CHR(M * 8 + 32 + (L div 10));
M := (K – (K div 100) * 100 – (M * 10));
TMP_STR := TMP_STR + CHR(M * 8 + 32 + (L div 10));
end
else
if (K < 100) and (K >= 10) then
begin
M := K div 10;
TMP_STR := TMP_STR + CHR(M * 8 + 32 + (L div 10));
M := (K – (M * 10));
TMP_STR := TMP_STR + CHR(M * 8 + 32 + (L div 10));
end;
end;
KIT_ENCRYPT := TMP_STR;
end;

procedure TGCFP.KIT_CONNECT_DB(NET_DIR: string; DB_NAME: TDATABASE; DB_DATABASENAME: string);
var
TXTF: TEXTFILE;
FILECONTENT: string;
SECTION_FOUND: INTEGER;
VAR_SECTION_NAME: string;
begin
DB_NAME.Close;
SECTION_FOUND := 0;
VAR_SECTION_NAME := ‘[ORACLE]’;
if FILEEXISTS(NET_DIR) or FILEEXISTS(‘C:/VMORA/MIS/MAIN_C/DBLOGIN.INI’) or FILEEXISTS(‘D:/VMORA/MIS/MAIN_C/DBLOGIN.INI’) or FILEEXISTS(‘E:/VMORA/MIS/MAIN_C/DBLOGIN.INI’) then
begin
DB_NAME.PARAMS.CLEAR;
try
if FILEEXISTS(NET_DIR) then
ASSIGNFILE(TXTF, NET_DIR)
else if FILEEXISTS(‘C:/VMORA/MIS/MAIN_C/DBLOGIN.INI’) then
ASSIGNFILE(TXTF, ‘C:/VMORA/MIS/MAIN_C/DBLOGIN.INI’)
else if FILEEXISTS(‘D:/VMORA/MIS/MAIN_C/DBLOGIN.INI’) then
ASSIGNFILE(TXTF, ‘D:/VMORA/MIS/MAIN_C/DBLOGIN.INI’)
else if FILEEXISTS(‘E:/VMORA/MIS/MAIN_C/DBLOGIN.INI’) then
ASSIGNFILE(TXTF, ‘E:/VMORA/MIS/MAIN_C/DBLOGIN.INI’);
RESET(TXTF);
while not EOF(TXTF) do
begin
READLN(TXTF, FILECONTENT);
FILECONTENT := TRIM(FILECONTENT);
if FILECONTENT = ” then CONTINUE;
if (not ((FILECONTENT[1] = ‘[‘) or (FILECONTENT[1] = ‘;’))) and (SECTION_FOUND = 1) then
DB_NAME.PARAMS.ADD(FILECONTENT);

if (FILECONTENT[1] = ‘[‘) then
begin
if SECTION_FOUND = 1 then
BREAK;
if FILECONTENT = VAR_SECTION_NAME then
SECTION_FOUND := 1;
end;
end;

with DB_NAME.PARAMS do
if INDEXOFNAME(‘PASSWORD’) <> -1 then
VALUES[‘PASSWORD’] := KIT_DECRYPT(VALUES[‘PASSWORD’]);
CLOSEFILE(TXTF);
except
CLOSEFILE(TXTF);
end;
end;

if not DB_NAME.Connected then
begin
DB_NAME.DatabaseName := DB_DATABASENAME;
DB_NAME.Connected := TRUE;
DB_NAME.KeepConnection := TRUE;
end;

end;

procedure TGCFP.KIT_CALL_EXTERNAL_EXE(EXE_DIR: string);
var
SCOMMANDLINE: string;
LPSTARTUPINFO: TSTARTUPINFO;
LPPROCESSINFORMATION: TPROCESSINFORMATION;
begin
SCOMMANDLINE := EXE_DIR;
FILLCHAR(LPSTARTUPINFO, SIZEOF(TSTARTUPINFO), #0);
LPSTARTUPINFO.CB := SIZEOF(TSTARTUPINFO);
LPSTARTUPINFO.DWFLAGS := STARTF_USESHOWWINDOW;
LPSTARTUPINFO.WSHOWWINDOW := SW_NORMAL;
CREATEPROCESS(nil, PCHAR(SCOMMANDLINE),
nil, nil, TRUE, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
nil, nil, LPSTARTUPINFO, LPPROCESSINFORMATION);
end;

procedure TGCFP.KIT_OPEN_SINGLE_PROC(SRC_APP: PCHAR);
var
hMutex: HWND;
Ret: Integer;
begin
Application.Initialize;
Application.Title := SRC_APP;
hMutex := CreateMutex(nil, False, SRC_APP);
Ret := GetLastError;
if Ret = ERROR_ALREADY_EXISTS then
begin;
ReleaseMutex(hMutex);
application.Terminate;
end
else
ReleaseMutex(hMutex);
end;

procedure TGCFP.KIT_ENTER_REPLACE_TAB(SRC_CUSTFORM: TCustomForm; SRC_KEY: CHAR);
begin
if SRC_Key = #13 then
if not (SRC_CUSTFORM.ActiveControl is TDBGrid) then
begin
// SRC_Key := #0;
SRC_CUSTFORM.Perform(WM_NEXTDLGCTL, 0, 0);
end
else
if (SRC_CUSTFORM.ActiveControl is TDBGrid) then
with TDBGrid(SRC_CUSTFORM.ActiveControl) do
if selectedindex < (fieldcount - 1) then selectedindex := selectedindex + 1 else selectedindex := 0; end; procedure TGCFP.KIT_EXEC_IUD_SQL(SQL_TXT: string; SRC_FORM: TFORM); var QUERY1: TQUERY; begin QUERY1 := TQUERY.CREATE(SRC_FORM); try with QUERY1 do begin CLOSE; SQL.CLEAR; SQL.TEXT := SQL_TXT; PREPARE; EXECSQL; end; QUERY1.FREE; except QUERY1.FREE; end; end; procedure TGCFP.KIT_Open_Child_Form(FormClass: TFormClass; var Fm; AOwner: TComponent); var i: integer; Child: TForm; begin for i := 0 to Screen.FormCount - 1 do if Screen.Forms[i].ClassType = FormClass then begin Child := Screen.Forms[i]; if Child.WindowState = wsMinimized then ShowWindow(Child.handle, SW_SHOWNORMAL) else ShowWindow(Child.handle, SW_SHOWNA); if (not Child.Visible) then Child.Visible := True; Child.BringToFront; Child.Setfocus; TForm(Fm) := Child; exit; end; Child := TForm(FormClass.NewInstance); TForm(fm) := Child; Child.Create(AOwner); end; procedure TGCFP.KIT_DBGRID_TO_EXCEL(SRC_DBG: TDBGRID); var EXCEL: VARIANT; EXCEL_WORKBOOK: VARIANT; EXCEL_WORKSHEET: VARIANT; SAVEDIALOG1: TSAVEDIALOG; I, J: INTEGER; CUR_DIR: string; begin try { SRC_DBG; SRC_DBG.DATASOURCE.DATASET; } with SRC_DBG.DATASOURCE.DATASET do if (BOF and EOF) then EXIT; if (SRC_DBG.DATASOURCE.DATASET.STATE = DSEDIT) or (SRC_DBG.DATASOURCE.DATASET.STATE = DSINSERT) then begin SHOWMESSAGE('数据表格处于编辑或新增记录状态,请保存或取消修改后重试一次'); EXIT; end; try EXCEL := CREATEOLEOBJECT('EXCEL.APPLICATION'); except SHOWMESSAGE('EXCEL MAY NOT BE INSTALLED'); ABORT; EXIT; end; SAVEDIALOG1 := TSAVEDIALOG.CREATE(SELF); SAVEDIALOG1.DEFAULTEXT := 'XLS'; SAVEDIALOG1.FILTER := '*.XLS'; GETDIR(0, CUR_DIR); SAVEDIALOG1.INITIALDIR := CUR_DIR; if SAVEDIALOG1.EXECUTE then begin if FILEEXISTS(SAVEDIALOG1.FILENAME) then begin if MESSAGEDLG('本程序固定将表格内容写入所选EXCEL文件的左上方,视表格内容定佔用篇幅,如果你的EXCEL文件该区已有内容,则会被覆写,要继续吗?', MTCONFIRMATION, [MBNO, MBYES], 0) = MRNO then EXIT; EXCEL.WORKBOOKS.OPEN(SAVEDIALOG1.FILENAME); end else EXCEL.WORKBOOKS.ADD(1); end else begin SHOWMESSAGE('未指定要保存的文件名,退出....'); EXIT; end; EXCEL_WORKBOOK := EXCEL.APPLICATION.WORKBOOKS[1]; EXCEL_WORKSHEET := EXCEL_WORKBOOK.WORKSHEETS[1]; for I := 0 to SRC_DBG.COLUMNS.COUNT - 1 do begin EXCEL_WORKSHEET.CELLS.ITEM[1, I + 1] := SRC_DBG.COLUMNS[I].TITLE.CAPTION; end; J := 2; with SRC_DBG.DATASOURCE.DATASET do begin DISABLECONTROLS; FIRST; while not EOF do begin for I := 0 to SRC_DBG.COLUMNS.COUNT - 1 do begin // SHOWMESSAGE(SRC_DBG.COLUMNS[I].FIELDNAME); EXCEL_WORKSHEET.CELLS.ITEM[J, I + 1] := TRIM(FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).ASSTRING); end; NEXT; J := J + 1; end; ENABLECONTROLS; end; EXCEL_WORKBOOK.SAVEAS(SAVEDIALOG1.FILENAME); EXCEL.APPLICATION.QUIT; SHOWMESSAGE('成功保存到文件 : ' + SAVEDIALOG1.FILENAME); SAVEDIALOG1.FREE; except SAVEDIALOG1.FREE; SRC_DBG.DATASOURCE.DATASET.ENABLECONTROLS; EXCEL.APPLICATION.QUIT; EXCEL_WORKSHEET.FREE; EXCEL_WORKBOOK.FREE; EXCEL.FREE; SHOWMESSAGE('保存失败,请确认该文件是否处于打开状态!确认将其关闭后再试一次!'); end; end; procedure TGCFP.KIT_SEARCH_IN_DBGRID(SRC_DBG: TDBGRID); var I, K: INTEGER; INPUTSTR, TMPSTR: string; CLICKOK: BOOLEAN; begin INPUTSTR := 'STRING TO SEARCH'; CLICKOK := INPUTQUERY('寻找', 'SEARCH', INPUTSTR); if not CLICKOK then EXIT; if SRC_DBG.DATASOURCE.DATASET.NAME <> DATASET_NAME then
J := 0;
if INPUTSTR <> LAST_STR then
J := 0;

DATASET_NAME := SRC_DBG.DATASOURCE.DATASET.NAME;
LAST_STR := INPUTSTR;

K := 0;
J := J + 1;

with SRC_DBG.DATASOURCE.DATASET do
begin
FIRST;
while not EOF do
begin
for I := 0 to SRC_DBG.COLUMNS.COUNT – 1 do
begin
if FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).DATATYPE = FTDATETIME then
TMPSTR := DATETIMETOSTR(FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).ASDATETIME)
else if FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).DATATYPE = FTINTEGER then
TMPSTR := INTTOSTR(FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).ASINTEGER)
else
TMPSTR := FIELDBYNAME(SRC_DBG.COLUMNS[I].FIELDNAME).ASSTRING;

if UPPERCASE(INPUTSTR) = TMPSTR then

begin
K := K + 1;
if K = J then
begin
SRC_DBG.FIELDS[I].FOCUSCONTROL;
EXIT;
end;
end;
end;
NEXT;
end;
J := 0;
end;
end;

procedure TGCFP.KIT_SENDMAIL_SMTP(FILPATH: string); //SEND_MAIL
var
fil: tinifile;
nms: TNMSMTP;
I: INTEGER;
begin
fil := tinifile.Create(FILPATH);
nms := tnmsmtp.Create(SELF);
nms.Charset := fil.ReadString(‘NMS’, ‘CHARSET’, ”);
NMS.Host := FIL.ReadString(‘NMS’, ‘HOST’, ”);
NMS.Port := STRTOINT(FIL.ReadString(‘NMS’, ‘PORT’, ”));
NMS.PostMessage.Attachments.Clear;
if FIL.ReadString(‘POSTMSG’, ‘ATT’, ”) = ‘LOADFROMTHIS’ then
for I := 1 to STRTOINT(TRIM(FIL.ReadString(‘POSTMSG’, ‘ATTMSG’, ”))) do
NMS.PostMessage.Attachments.Add(FIL.ReadString(‘POSTMSG’, ‘ATT’ + INTTOSTR(I), ”))
else if FIL.ReadString(‘POSTMSG’, ‘ATT’, ”) = ‘FILES’ then
NMS.PostMessage.Attachments.LoadFromFile(FIL.ReadString(‘POSTMSG’, ‘ATTMSG’, ”))
else if FIL.ReadString(‘POSTMSG’, ‘ATT’, ”) = ‘NONE’ then
begin
SHOWMESSAGE(‘您的ATT标识有误！’);
EXIT;
end;

NMS.PostMessage.Body.Clear;
if FIL.ReadString(‘POSTMSG’, ‘BODY’, ”) = ‘FILES’ then
NMS.PostMessage.Body.LoadFromFile(FIL.ReadString(‘POSTMSG’, ‘BODYMSG’, ”))
else if FIL.ReadString(‘POSTMSG’, ‘BODY’, ”) = ‘LOADFROMTHIS’ then
for I := 1 to STRTOINT(TRIM(FIL.ReadString(‘POSTMSG’, ‘BODYMSG’, ”))) do
NMS.PostMessage.Body.Add(FIL.ReadString(‘POSTMSG’, ‘BODY’ + INTTOSTR(I), ”))
else if FIL.ReadString(‘POSTMSG’, ‘BODY’, ”) = ‘NONE’ then
begin
SHOWMESSAGE(‘您的BODY标识有误！’);
EXIT;
end;

NMS.PostMessage.ToCarbonCopy.Clear;
if FIL.ReadString(‘POSTMSG’, ‘CC’, ”) = ‘FILES’ then
NMS.PostMessage.ToCarbonCopy.LoadFromFile(FIL.ReadString(‘POSTMSG’, ‘CCMSG’, ”))
else if FIL.ReadString(‘POSTMSG’, ‘CC’, ”) = ‘LOADFROMTHIS’ then
for I := 1 to STRTOINT(TRIM(FIL.ReadString(‘POSTMSG’, ‘CCMSG’, ”))) do
NMS.PostMessage.ToCarbonCopy.Add(FIL.ReadString(‘POSTMSG’, ‘CC’ + INTTOSTR(I), ”))
else if FIL.ReadString(‘POSTMSG’, ‘CC’, ”) = ‘NONE’ then
begin
SHOWMESSAGE(‘您的ToCarbonCopy标识有误！’);
EXIT;
end;

NMS.PostMessage.ToBlindCarbonCopy.Clear;
if FIL.ReadString(‘POSTMSG’, ‘BCC’, ”) = ‘FILES’ then
NMS.PostMessage.ToBlindCarbonCopy.LoadFromFile(FIL.ReadString(‘POSTMSG’, ‘BCCMSG’, ”))
else if FIL.ReadString(‘POSTMSG’, ‘BCC’, ”) = ‘LOADFROMTHIS’ then
for I := 1 to STRTOINT(TRIM(FIL.ReadString(‘POSTMSG’, ‘BCCMSG’, ”))) do
NMS.PostMessage.ToBlindCarbonCopy.Add(FIL.ReadString(‘POSTMSG’, ‘BCC’ + INTTOSTR(I), ”))
else if FIL.ReadString(‘POSTMSG’, ‘BCC’, ”) = ‘NONE’ then
begin
SHOWMESSAGE(‘您的ToBlindCarbonCopy标识有误！’);
EXIT;
end;

NMS.PostMessage.Date := FIL.ReadString(‘POSTMSG’, ‘DATE’, ”);
NMS.PostMessage.FromAddress := FIL.ReadString(‘POSTMSG’, ‘FROMADD’, ”);
NMS.PostMessage.FromName := FIL.ReadString(‘POSTMSG’, ‘FROMNAME’, ”);
NMS.PostMessage.Subject := FIL.ReadString(‘POSTMSG’, ‘SUBJECT’, ”);
NMS.PostMessage.ToAddress.Clear;

if FIL.ReadString(‘POSTMSG’, ‘TOADD’, ”) = ‘LOADFROMTHIS’ then
for I := 1 to STRTOINT(TRIM(FIL.ReadString(‘POSTMSG’, ‘TOADDMSG’, ”))) do
NMS.PostMessage.ToAddress.Add(FIL.ReadString(‘POSTMSG’, ‘TOADD’ + INTTOSTR(I), ”))
else if FIL.ReadString(‘POSTMSG’, ‘TOADD’, ”) = ‘FILES’ then
NMS.PostMessage.ToAddress.LoadFromFile(FIL.ReadString(‘POSTMSG’, ‘TOADDMSG’, ”))
else if FIL.ReadString(‘POSTMSG’, ‘TOADD’, ”) = ‘NONE’ then
begin
SHOWMESSAGE(‘您的TOADD标识有误！’);
EXIT;
end;

NMS.Connect;
NMS.SendMail;
NMS.Disconnect;
FIL.Free;
NMS.Free;
end;

end.