dephi 函數庫
{函數庫說明:此函數是為提高編程效率,減少代碼重用所收集的
調用方法: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;
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_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
[email protected]
FROMNAME=中國人
SUBJECT=a test
TOADD=LOADFROMTHIS
(收件人列表,用法同ATT)
TOADDMSG=2
[email protected]
[email protected]
}
procedure PRO_INPUT_NUM_ONLY(var Key: Char; IS_INPUT_POINT: string; TEXT: string);
{功能:限制隻能輸入數字和BackSpace，IS_INPUT_POINT為'Y'則可以輸入小數點,'N'則不可以輸入小數點}
private
{ Private declarations }
public
{ Public declarations }
end;
var
GC: TGCFP; {全局單元}
DATASET_NAME, LAST_STR: string;
J: INTEGER;
implementation
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
// SHOWMESSAGE(INTTOSTR(LENGTH(TEXT)));
if (LENGTH(TEXT) = 0) and (KEY = '.') then
begin
KEY := #0;
EXIT;
end;
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
begin
KEY := #0;
EXIT;
end;
if KEY <> #0 then
begin
KEY := KEY;
EXIT;
end;
end
else
key := #0;
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
OPENDIALOG1 := TOPENDIALOG.CREATE(SRC_DBE);
OPENDIALOG1.DEFAULTEXT := 'XLS';
OPENDIALOG1.FILTER := 'EXCEL FILE|*.XLS';
GETDIR(0, INI_DIR);
OPENDIALOG1.INITIALDIR := INI_DIR;
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;
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;
OPENDIALOG1: TOPENDIALOG;
I, J: INTEGER;
CUR_DIR: string;
begin
OPENDIALOG1 := TOPENDIALOG.CREATE(SELF);
OPENDIALOG1.DEFAULTEXT := 'XLS';
OPENDIALOG1.FILTER := '*.XLS';
GETDIR(0, CUR_DIR);
OPENDIALOG1.INITIALDIR := CUR_DIR;
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;
if OPENDIALOG1.EXECUTE then
begin
if FILEEXISTS(OPENDIALOG1.FILENAME) then
begin
if MESSAGEDLG('本程序固定將表格內容寫入所選EXCEL文件的左上方,視表格內容定佔用篇幅,如果你的EXCEL文件該區已有內容,則會被覆寫,要繼續嗎?', MTCONFIRMATION, [MBNO, MBYES], 0) = MRNO then
EXIT;
EXCEL.WORKBOOKS.OPEN(OPENDIALOG1.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
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(OPENDIALOG1.FILENAME);
EXCEL.APPLICATION.QUIT;
SHOWMESSAGE('成功保存到文件 : ' + OPENDIALOG1.FILENAME);
OPENDIALOG1.FREE;
except
OPENDIALOG1.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.