Function getkbstatus (): String;
/ / Return to the current keyboard status, including Numloce, Caps Lock, Insert
// Each status information takes two characters, the order is: Numloce, Caps Lock, INSERT
// Copy Right
549 @ 11: 29 2003-7-22
Var status: string;
KeyStates: tKeyboardState;
Begin
GetKeyboardState (keystates);
IF odd (KeyStates [vk_numlock])
Status: = 'Number'
Else
Status: = 'cursor';
IF odd (KeyStates [vk_capital] ")
Status: = status 'uppercase'
Else
Status: = status 'lowercase';
IF odd (KeyStates [vk_insert])
Status: = status 'insert'
Else
Status: = status 'rewriting';
Result: = status;
END;
Tips:
Const errhead = 'operation error, error message is:' # 13
Try
...
Except
ON E: Exception Do ShowMessage (ErrHead E.Message # 13 'Current operation is: xxxxx');
END;
You can let users see more error messages to help customers feedback program errors.
It is often written by comparative dishes, but often uses:
/>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>
// Execute SQL
// Enter parameters: Sqlstring, AdoQuery
// Type: String, TadoQuery
Procedure TMAINFORM.EXESQL (SQLSTRING: STRING; AdoQuery: tadoquery);
Begin
With adoQuery do
Begin
Connection: = dm.dbaccinfo; // This is mine, you can add Connection
// or use USE.
IF Active Then
Active: = FALSE;
Open;
SQL.CLEAR;
SQL.Add (Sqlstring);
EXECSQL;
CLOSE;
END;
END;
Maybe everyone knows this. However, I have seen the code,
It seems that a few people have written so independently.
This guarantees my own original ...
// Open AdoQuery
/ / According to Reallike (AXA (only lizzy can be called other people can't)
/ / Support Multi-line SQL
// You can modify the process of only supporting single-line SQL as needed, or the exec process
// Delphi6 under test. Procedure OpenSQL (SQLSTRING: TSTRINGS; AdoQuery: tadoquery);
VAR i: integer;
Begin
With adoQuery do
Begin
CLOSE;
SQL.CLEAR;
For i: = 0 to sqlstring.count-1 do
SQL.Add (Sqlstring [i]);
Try
Open;
Except
ON E: Exception Do ShowMessage ('error: Information is the following' # 13 E.MESSAGE);
END;
END;
END;
This is a single line of SQL
Procedure OpenSQL1 (SQLSTRING: STRING; AdoQuery: TadoQuery);
Begin
With adoQuery do
Begin
CLOSE;
SQL.CLEAR;
SQL.Add (Sqlstring);
Try
Open;
Except
ON E: Exception Do ShowMessage ('error: Information is the following' # 13 E.MESSAGE);
END;
END;
END;
Hey, thank you for helping me repair this.
But don't you use EXECSQL?
I usually add TRY outside this process is to reference him.
That is
Try
Exesql (Sqlstring, AdoQuery1)
Except
// Error prompt, messy things.
end
To: Reallike (AXIK (only lizzy can be called other people))
Execsql, I also did it.
// EXECSQL AdoQuery
/ / Support Multi-line SQL
// You can modify the process of only supporting single-line SQL as needed, or the exec process
// Delphi6 under test.
Procedure EXESQL (SQLSTRING: TSTRINGS; AdoQuery: tadoquery);
VAR i: integer;
Begin
With adoquery do begin
CLOSE;
SQL.CLEAR;
For i: = 0 to sqlstring.count-1 do
SQL.Add (Sqlstring [i]);
Try
EXECSQL;
Except
ON E: Exception Do ShowMessage ('error: Information is the following' # 13 E.MESSAGE);
END;
END;
END;
// I think Except is the same, put it outside, because you can add some other debugging information.
// What do you say?
// Does anyone merge into one of these two processes that perform a single line and perform multiple lines, that's it.
I also come back, I can delete according to my needs, but it is for DBGrideh:
// Dynamically establish a colol
Procedure Buildcol (vfieldname: string; vcAption: string; vwidth: integer; var
Vgrid: TDBGRIDEH; Itag: integer = 0;
Footertype: tfootervalueType = fvtnon; footertext: string = '';
BOOLREADONLY: BOOLEAN = true; vcolor: tcolor = CLBTNFACE);
VAR
CCOL: TDBGRIDCOLUMNEH;
Cfootercol: tcolumnfootereh;
Begin
Ccol: = tdbgridcolumneh.create (vgrid.columns); ccol.fieldname: = vfieldname;
Ccol.width: = vWidth;
Ccol.title.caption: = vcaption;
Ccol.title.Alignment: = Tacenter;
Ccol.title.color: = vcolor;
Ccol.readonly: = boolreadonly;
// If the TAG value is -1, the column is not printed when printing DBGRID.
Ccol.tag: = ITAG;
IF FooterType <> fvtnon kil
Begin
Cfootercol: = ccol.footers.Add;
Cfootercol.valueType: = Footertype;
IF footerType = fvtstatictext then
Begin
Vgrid.footerrowcount: = 1;
Cfootercol.value: = footertext;
END;
//ccol.footer.fieldname:=;
END;
END;
Procedure Titlebtnclick (Sender: Tobject; Acol: Integer;
COLUMN: TCOLUMNEH; CDSHELPER: TCLIENTDATAELPER);
VAR
CDSTMP: TclientDataSet;
Begin
With (Sender As TdbGrideh) DO
Begin
CDSTMP: = (Datasource.DataSet as TclientDataSet);
If not cdstmp.active kilns;
/ / Set the sorting method of the current line
if column.title.sortmarker = SMNONEEH THEN
Begin
Column.title.sortmarker: = smupeh;
Cdshelper.Sortbyfield (Column.fieldName, Soascending);
end
Else
if Column.title.Sortmarker = SMUPEH THEN
Begin
Column.title.sortmarker: = smdowneh;
Cdshelper.sortbyfield (Column.fieldName, Sodescending);
end
Else
Begin
Column.title.sortmarker: = SMNONEEH;
Cdshelper.Sortbyfield (Column.fieldName, Sonosort);
END;
END;
END;
Record the positions and widths of each column in DBGRID into the INI file, and read a function of each column and width in DBGRID from the INI file.
Procedure f_readini (const now_dbgrid: tdbgrid; form_name: string);
VAR
FilePath: String;
MyiniFile: tinifile;
Grid_name, Field_Name: String;
Width: integer;
I, J, N: Integer;
COLUMN: Array [0..100] of String;
Widths: array [0..100] OF INTEGER;
Begin
Filepath: = extractFilepath (Application.exename);
Myinifile: = tinifile.create (FilePath 'gsp.ini'); grid_name: = form_name ',' now_dbgrid.name;
N: = now_dbgrid.columns.count-1;
For i: = 0 to 100 do column [i]: = ';
For i: = 0 to n DO
Begin
Field_name: = now_dbgrid.columns [i] .fieldname
J: = MyiniFile.Readinteger (grid_name, field_name, i);
Column [J]: = field_name;
Widths [J]: = MyiniFile.Readinteger (Grid_name, Field_Name '_ width', now_dbgrid.columns [i] .width);
END;
For i: = 0 to n DO
Begin
Now_dbgrid.columns [i] .fieldname: = column [i];
Now_dbgrid.columns [i] .width: = Widths [i];
END;
MyiniFile.Destroy;
END;
Procedure f_writeini (const now_dbgrid: tdbgrid; form_name: string);
VAR
FilePath: String;
MyiniFile: tinifile;
Grid_name, Field_Name: String;
Width: integer;
i: integer;
Begin
Filepath: = extractFilepath (Application.exename);
Myinifile: = Tinifile.create (filepath gsp.ini ');
Grid_name: = form_name ',' now_dbgrid.name;
For i: = 0 to now_dbgrid.column.count-1 do
Begin
Field_name: = now_dbgrid.columns [i] .fieldname
Width: = now_dbgrid.columns [i] .width;
MyiniFile.Writeinteger (grid_name, field_name, i);
MyiniFile.Writeinteger (Grid_name, Field_Name '_ width', width);
END;
MyiniFile.Destroy;
END;
I have written a long time, now I have packaged it.
Unit myfunc;
Interface
Uses
Windows, sysutils, mmsystem, winsvc, registry;
Function CopyStrLeft (CH: CHAR; Str: String): String;
Function CopyStrright (CH: Char; str: string): String;
Function GetselfPath: string;
Procedure Hidetask (BHIDE: BOOLEAN);
Function SoundCardInstalled: boolean;
Function gethostip: String;
Procedure Disablesvc (SVCName: String);
Function getRegisteredowner: string;
Function getRegisteeredorganization: string; importation
Function RegisterServiceProcess (dwprocessid, dwtype: integer): integer; stdcall; external 'kernel32.dll';
Function CopyStrLeft (CH: CHAR; Str: String): String;
Begin
Result: = COPY (STR, 1, POS (CH, STR) -1)
END;
Function CopyStrright (CH: Char; str: string): String;
Begin
Result: = COPY (STR, POS (CH, STR) 1, Length (STR) -POS (CH, STR) 1)
END;
Function GetselfPath: string;
Begin
Result: = ExtractFilePath (paramstr (0))
END;
Procedure Hidetask (BHIDE: BOOLEAN);
Begin
IF Bhide Then RegisterServiceProcess (getcurrentProcessid, 1)
Else RegisterServiceProcess (getcurrentprocessid, 0);
END;
Function SoundCardInstalled: boolean;
Begin
Result: = WaveoutGetnumdevs> 0
END;
Function gethostip: String;
Type
Tapinaddr = array [0..10] of pinaddr;
Papinaddr = ^ TapinAddr;
VAR
Phe: phostent;
Pptr: papinaddr;
Buffer: array [0..63] of char;
I: integer;
GinitData: TWSADATA;
Begin
WSAStartup ($ 101, ginitdata);
GethostName (Buffer, Sizeof (Buffer);
Phe: = gethostByname (buffer);
IF PHE = NIL THEN EXIT;
PPTR: = papinaddr (Phe ^ .h_addr_list);
I: = 0;
Result: = INET_NTOA (PPTR ^ [i] ^);
WSACLEANUP;
END;
Procedure Disablesvc (SVCName: String);
VAR
SCMNGR: THANDLE;
SCSVC: THANDLE;
Begin
SCMNGR: = OPENSCMANAGER (NIL, NIL, SC_MANAGER_ALL_ACCESS);
SCSVC: = OpenService (scmngr, svcname, service_change_config);
ChangeServiceConfig (SCSVC,
Service_no_change,
Service_disabled,
Service_no_change,
NIL, NIL, NIL, NIL, NIL, NIL, NIL);
ClosESERVICEHANDLE (SCSVC);
END;
Function getRegisteredowner: string;
VAR
Osversion: tosversioninfo;
Swinkey: String;
Begin
Osversion.dwosversionInfosize: = sizeof (Osversion);
GetversionEx (Osversion); Case Osversion.dwplatformID of
Ver_Platform_WIN32_WINDOWS: SWINKEY: = '/ Software / Microsoft / Windows / CurrentVersion';
Ver_Platform_WIN32_NT: SWINKEY: = '/ Software / Microsoft / Windows NT / CurrentVersion';
END;
With tregistry.create do
Try
RootKey: = HKEY_LOCAL_MACHINE
OpenKey (Swinkey, False);
Result: = ReadString ('registeredowner');
Finally
FREE;
END;
END;
Function getRegisteredOrganization: string;
VAR
Osversion: tosversioninfo;
Swinkey: String;
Begin
Osversion.dwosversionInfosize: = sizeof (Osversion);
GetversionEx (Osversion);
Case Osversion.dwplatformID of
Ver_Platform_WIN32_WINDOWS: SWINKEY: = '/ Software / Microsoft / Windows / CurrentVersion';
Ver_Platform_WIN32_NT: SWINKEY: = '/ Software / Microsoft / Windows NT / CurrentVersion';
END;
With tregistry.create do
Try
RootKey: = HKEY_LOCAL_MACHINE
OpenKey (Swinkey, False);
Result: = readstring ('registeredorganization ";
Finally
FREE;
END;
END;
End.
Put a few more
/ / Delete all specified extensions in a directory
Function Delfile (SDIR, FEXT: STRING): Boolean;
VAR
Hfindfile: hwnd;
FindFileData: Win32_find_data;
SR: TSEARCHREC;
Begin
SDIR: = SDIR '/';
Hfindfile: = FindfirstFile (Pchar (SDIR FEXT), FINDFILEDATA);
IF HFINDFILE <> Null Then
Begin
Deletefile (SDIR FINDFILEDATA.CFILENAME);
While FindNextFile (Hfindfile, FindFileData) <> false do
Deletefile (SDIR FINDFILEDATA.CFILENAME);
END;
Sr.FindHandle: = hfindfile;
FindClose (SR);
END;
// delay
Procedure MDELAY (MSECS: DWORD);
VAR
Begintime: DWORD;
Begin
Begintime: = gettickcount;
Repeat
Application.ProcessMESSAGES;
Until gettickcount - begintime> = msecs;
END;
/ / Format floating point
Function my_formatfloat (r: real; u: integer): Real;
VAR
vstr: string;
I: integer;
Begin
IF u <= 0 THEN
Result: = r
Else
Begin
vStr: = '0';
For i: = 1 to U - 1 DO
vstr: = vstr '0';
vStr: = '0.' vStr;
Result: = StrtOFLOAT (Formatfloat (VSTR, R));
END;
END;
// Get the substrings of the specified position in a string
// Return 'CC', such as get_substr
Function get_substr (s_str, d_str: string; po: integer): string; // s_str large string, D_STR separator, PO location
VAR
I, J, K: Integer;
Begin
Result: = '';
IF Po <1 THEN
EXIT;
S_STR: = Trim (S_STR) D_STR;
I: = 0;
While 1 = 1 DO
Begin
IF POS (D_STR, S_STR)> 0 THEN
Begin
J: = POS (D_STR, S_STR) Length (D_STR);
K: = Length (S_STR) - (J-1);
i: = i 1;
IF i = PO THEN
Begin
J: = POS (D_STR, S_STR);
Result: = COPY (S_STR, 1, J-1);
Break;
END;
S_STR: = COPY (S_STR, J, K);
end
Else
Break;
END;
END;
// Get the last day of the current date and the last day
Function get_date (Da: TDATETIME; ZT: Integer): TDATETIME;
VAR
YY, MM, DD: String;
Begin
YY: = formatdatetime ('YYYY', DA);
mm: = formatdatetime ('mm', da);
IF zt = 0 THEN
DD: = '01'
Else
Begin
IF Strtoint (mm) in [1, 3, 5, 7, 8, 10, 12] THEN
DD: = '31'
Else
IF mm <> '2' Then
DD: = '30'
Else
IF IsleApyear (Yearof (DA)) THEN
DD: = '29'
Else
DD: = '28';
END;
Dateseparator: = '-';
Result: = STRTODATE (YY '-' MM '-' DD);
END;
// Does the existence of the table
Function ISEXIST (TB: String; Query: tadoquery): Boolean;
VAR
SQLSTR: STRING;
Begin
SQLSTR: = 'SELECT * from sysobjects where id = Object_ID (' ' tb ' ')'; with query do
Begin
CLOSE;
SQL.CLEAR;
SQL.Add (SQLSTR);
Open;
END;
if query.recordset.eof kil
Isexist: = false
Else
ISEXIST: = TRUE;
END;
// is used in Excel, equivalent to 26 credit conversion
Function Int2Letter (NUM: Integer): String;
Const
Letterstr = 'AbcdefghijklmnopqrStuvwxyz';
VAR
I, J: Integer;
Begin
IF Num <= 26 THEN
Begin
Result: = letterstr [Num];
end
Else
Begin
J: = Num MOD 26;
I: = Num DIV 26;
IF j = 0 THEN
Begin
J: = 26;
I: = I-1;
END;
Result: = int2letter (i) letterstr [j];
END;
END;
/ / Is integrity
Function isint (astr: string): boolean;
VAR
Value, Code: Integer;
Begin
Val (Astr, Value, Code);
Result: = Code = 0;
END;
/ / Whether floating point
Function isfloat (astr: string): boolean;
VAR
VALUE: REAL;
Code: integer;
Begin
Val (Astr, Value, Code);
Result: = Code = 0;
END;
Next, come back :)
Procedure runscreensave ();
// - Run screen protection
Begin
SendMessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0);
END;
// The following two functions are all rounded, mainly to show a way of thinking, which one can be used.
Function Myround (Value: Double): Integer;
// Take all four rounds
// This copyright belongs to Xiao Feng
Begin
Result: = start (formatfloat ('#', value));
END;
Function Doround (Value: Double): Integer;
// Take all four rounds
// I have half this, huh, huh.
Begin
IF value <0 Then Result: = - DOROUND (-Value)
Else
Result: = ROUND (int ((value 0.5) * 10))) DIV 10;
END;
// Of course, this function has other ways, if you have different ideas welcome to continue. . .
Supplementary description:
This function itself uses the "four-way five-way double" rule, although more scientific, but there are not several in practical applications.
I also posted a few of myself:
{------------------------------------- ----------------------------
Process name: MSG
Author: Gongqin
Date: 2003-6-9 16:57:44 Parameters: amsg: string; atitle: String = 'prompt'; atype: byte = 0; btn: longint = 0
Atype: = 1 Display "Information" icon
2 Show "Error" icon
AMSG (Display Message) Atitle (Show Title)
BTN: = 0 shows OK
1 Show Ok Cancel
2 Show Yes NO
3 Show Retry and Cancel
4 Show Abort, Retry, And ignore
Return value: Integer
Description: Display Message Dialog
-------------------------------------------------- ---------------------------}
Function msg (amsg: string; atitle: string; atype: byte; btn: longint): integer
Var flag: longint;
Begin
Case atype of
1: flag: = MB_ICONQUESTION; / / Question
2: flag: = MB_ICONERROR; // Error
3: flag: = MB_ICONSTOP; // Stop
Else
Flag: = MB_ICONWARNING;
END;
Case btn of
0: flag: = flag MB_OK;
1: flag: = flag MB_OKCANCEL;
2: flag: = flag mb_yesno;
3: flag: = flag MB_YESNOCANCEL;
4: flag: = flag MB_RETRYCANCEL;
5: flag: = flag MB_AbortRetryIgnore;
END;
Result: = Application.MessageBox (Pchar (AMSG), Pchar (Atitle), FLAG)
END;
{------------------------------------- ----------------------------
Process Name: GetAppPath
Author: Gongqin
Date: 2003-6-9 17:01:17
Parameters: none
Return Value: String
Description: Take the path to the application
If only extractfilepath (extractfilepath (application.exename) is used to take the path
Maybe error, so add it
-------------------------------------------------- ---------------------------}
Function GetAppPath: String;
VAR
Strtmp: String;
Begin
Strtmp: = ExtractFilePath (applfilepath (application.exename);
IF stratmp [length (strtmp)] <> / 'THEN
Strtmp: = strtmp '/';
RESULT: = strtmp;
END;
Here is my own finish.
http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239
// Calculate the first month of the quarter of the current date and the last month / / ultimate version
Function quarterbegin (TDATE: TDATETIME = 0): Integer;
// Copy Right
549 @ 18: 25 2003-9-3
Begin
Result: = (quarter (has (theDate) - 1) * 3 1;
END;
Function quarterend (theDate: tdatetime = 0): Integer;
// Copy Right
549 @ 18: 25 2003-9-3
Begin
Result: = (quarter (theDate) - 1) * 3 3;
END;
Function quarter (theDate: tdatetime = 0): integer;
// Copy Right
549 @ 10: 06 2003-9-5
Begin
Result: = Monthof (thisDate);
if these = 0 Then Result: = MONTHOF (DATE);
Result: = (Result 2) DIV 3;
END;
