| Funktion getKBstatus (): String; // kehren Sie zum aktuellen Tastaturstatus zurück, einschließlich Numloce, Caps Lock, Isso // Jede Statusinformation nimmt zwei Zeichen in der Reihenfolge ein: numloce, Caps Lock, einfügen // Right 549@11: 29 2003-7-22 kopieren VAR -Status: String; Keystates: TKeyboardState; Beginnen GetKeyboardState (Keystates); Wenn ungerade (Keystates [vk_numlock]) dann Status: = 'Nummer' ' anders Status: = 'Cursor'; wenn ungerade (Keystates [vk_capital]) dann Status: = Status+'Caps' anders Status: = Status+'Kleinbuchstaben'; wenn ungerade (Keystates [vk_insert]) dann Status: = Status+'Einfügen' anders Status: = Status+'neu schreiben'; Ergebnisse: = Status; Ende; const erread = 'Der Fehler in der Operation ist aufgetreten, die Fehlermeldung lautet:'+#13 versuchen ... außer auf e: Ausnahme do showMessage (erread+e.message+#13+'Die aktuelle Operation ist: xxxxx'); Ende; Es ermöglicht Benutzern, mehr Fehlermeldungen anzuzeigen, mit denen Kunden Feedback -Programmfehler helfen können. Ich schreibe eine gute Idee, aber ich benutze sie oft: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>> // SQL ausführen // Eingabeparameter: SQLString, Adoquery // Typ: String, Tadoquery Procedure tmainForm.exesql (SQLString: String; Adoquery: Tadoquery); Beginnen mit Adoquery tun Beginnen Verbindung: = dm.dbaccinfo; // Dies ist meine, Sie können die Verbindung hinzufügen // oder benutze es. Wenn aktiv Aktiv: = falsch; Offen; Sql.clear; SQL.ADD (SQLString); Execsql; Schließen; Ende; Ende; In dem Code, den ich gesehen habe, scheint es jedoch, dass nur wenige Menschen einen so unabhängigen Prozess schreiben. Dies ist garantiert von mir selbst original ... // Adoquery öffnen // adaptiert aus dem Prozess von realähnlich (Aixiang (nur Lizzy kann gesagt werden, dass andere nicht können)) // Support Multi-Line SQL // Sie können es selbst ändern, um nur einzelne SQL-Prozeduren oder Exesql-Prozeduren zu unterstützen // Der Test unter Delphi6 bestand. Prozedur openensql (SQLString: tstrings; adoquery: tadoquery); var i: Ganzzahl; Beginnen mit Adoquery tun Beginnen Schließen; Sql.clear; für i: = 0 bis sqlstring.count-1 tun Sql.add (SQLString [i]); versuchen Offen; außer auf e: Ausnahme do showMessage ('Fehler: Die Nachricht lautet wie folgt'+#13+e.message); Ende; Ende; Ende; Dies ist eine einzelne SQL -Linie Prozedur OpenSQL1 (SQLString: String; Adoquery: Tadoquery); Beginnen mit Adoquery tun Beginnen Schließen; Sql.clear; SQL.ADD (SQLString); versuchen Offen; außer auf e: Ausnahme do showMessage ('Fehler: Die Nachricht lautet wie folgt'+#13+e.message); Ende; Ende; Ende; Hoho, danke, dass du mir geholfen hast, dieses Ding zu reparieren. Aber benutze du execsql nicht? Normalerweise füge ich es außerhalb dieses Prozesses hinzu, das heißt, wo er zitiert wird. Das ist Versuch Exesql (SQLString, Adoquery1) außer // Fehleraufforderung, unordentliches Zeug. Ende zu: echt ähnlich (Aixiang (nur Lizzy kann gesagt werden, dass andere nicht können)) Ich habe auch ausgeführt // ExecSQL Adoquery // Support Multi-Line SQL // Sie können es selbst ändern, um nur einzelne SQL-Prozeduren oder Exesql-Prozeduren zu unterstützen // Der Test unter Delphi6 bestand. Prozedur Exesql (SQLString: TStrings; Adoquery: Tadoquery); var i: Ganzzahl; Beginnen Mit Adoquery beginnen Schließen; Sql.clear; für i: = 0 bis sqlstring.count-1 tun Sql.add (SQLString [i]); versuchen Execsql; außer auf e: Ausnahme do showMessage ('Fehler: Die Nachricht lautet wie folgt'+#13+e.message); Ende; Ende; Ende; // Ich denke, es ist genauso, dass es besser ist, es nach draußen zu setzen, da Sie einige andere Debugging -Informationen hinzufügen können //Was denken Sie? // ist jeder kombiniert die beiden Prozesse der Ausführung einer einzelnen Zeile und der Ausführung mehrerer Zeilen in eine, das wäre großartig. Ich werde noch zwei machen und ich kann sie nach meinen Anforderungen hinzufügen und löschen, aber ich verwende dbgrideh, um Col dynamisch zu erstellen Prozedur BuildCol (vfieldName: String; VCaption: String; VWidth: Integer; var; VGRID: TDBGRIDEH; FootstoryPe: tfoterervalUetype = fvtnon; boolreadonly: boolean = true; var CCOL: TDBGRIDCOLUMNEH; CFoterercol: Tcolumnfotereh; Beginnen 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; // Wenn der Tag -Wert -1 ist, wird die Spalte beim Drucken von DBGrid nicht gedruckt ccol.tag: = itag; Beginnen cfoterercol: = ccol.foterers.add; cfoterercol.valuetype: = Fußgüter; Wenn foutstatertype = fvtStatictictext dann Beginnen vGrid.Foterrowcount: = 1; cfoterercol.Value: = footertext; Ende; //ccol.foter.fieldname:=; Ende; End; Prozedur titleBtnclick (Absender: Tobject; Acol: Integer; Säule: Tcolumneh; var CDSTMP: tclientDataset; Beginnen mit (Absender als tdbgrideh) tun Beginnen CDSTMP: = (DataSource.Dataset as TclientDataset); Wenn nicht CDSTMP.Active, dann beenden; // Stellen Sie die Sortiermethode der aktuellen Zeile fest if column.title.sortmarker = smnoneeh dann Beginnen Column.title.sortmarker: = smupeh; CDSHELPER.SORTBYFIELD (Column.FieldName, Soascending); Ende anders if column.title.sortmarker = smupeh dann Beginnen Column.title.sortmarker: = smdowneh; CDSHELPER.SORTBYFIELD (Column.FieldName, Sodescending); Ende anders Beginnen Column.title.sortmarker: = smnoneeh; CDSHELPER.SORTBYFIELD (COLMALTE.FIELDNAME, SONOSORT); Ende; Ende; Ende; Prozedur f_readini (const NOW_DBGRID: TDBGRID; Form_Name: String); var Filepath: String; MyInifile: Tinifile; Grid_name, field_name: String; Breite: Ganzzahl; I, J, N: Ganzzahl; Spalte: Array [0..100] der String; Breite: Array [0..100] der Ganzzahl; Beginnen Filepath: = extractFilepath (application.exename); MyInifile: = Tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+now_dbgrid.name; n: = now_dbgrid.columns.count-1; für i: = 0 zu n tun Beginnen Field_name: = now_dbgrid.columns [i] .fieldName; J: = myInifile.readinteger (Grid_name, field_name, i); Spalte [j]: = field_name; Widths [j]: = myInifile.readinteger (grid_name, field_name+'_ width', now_dbgrid.columns [i] .width); Ende; Beginnen Now_dbgrid.columns [i] .fieldName: = column [i]; Now_dbgrid.columns [i] .width: = widths [i]; Ende; End; Prozedur f_writeIni (const now_dbgrid: tdbgrid; Form_name: String); var Filepath: String; MyInifile: Tinifile; Grid_name, field_name: String; Breite: Ganzzahl; I: Ganzzahl; Beginnen Filepath: = extractFilepath (application.exename); MyInifile: = Tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+now_dbgrid.name; Beginnen Field_name: = now_dbgrid.columns [i] .fieldName; Breite: = now_dbgrid.columns [i] .width; MyInifile.writeInteger (grid_name, field_name, i); MyInifile.writeInteger (grid_name, field_name+'_ width', width); Ende; Ende; Einheit myfunc; Schnittstelle Verwendung Windows, Systems, MMSystem, Winsvc, Registrierung; Funktion copystrleft (ch: char; str: String): String; Funktion CopyStright (ch: char; str: String): String; Funktion GetselfPath: String; Verfahren Hidetask (BHIDE: Boolean); Funktion SoundCardinstalled: Boolean; Funktion Gethostip: String; Prozedur disablesVC (SVCName: String); Funktion getRegisteredowner: String; Funktion GetregisterDeorganisation: String; Beginnen Ergebnisse: = Copy (str, 1, pos (ch, str) -1) Ende; Funktion CopyStright (ch: char; str: String): String; Beginnen Ergebnisse: = Copy (str, pos (ch, str) +1, Länge (str) -Pos (ch, str) +1) Ende; Funktion GetselfPath: String; Beginnen Ergebnis: = extractFilepath (Paramstr (0)) Ende; Verfahren Hidetask (Bhide: Boolean); Beginnen Wenn Bhide dann registresserviceProcess (getCurrentProcessid, 1) sonst registerserviceProcess (getCurrentProcessid, 0); Ende; Funktion SoundCardinstalled: boolean; Beginnen Ergebnis: = WaveoutgetNumdevs> 0 Ende; Funktion Gethostip: String; Typ Tapinaddr = Array [0..10] von Pinaddr; Papinaddr = ^tapinaddr; var Phe: Phostent; PPTR: Papinaddr; Puffer: Array [0..63] von Char; I: Ganzzahl; Ginitdata: twsadata; Beginnen Wsastartup ($ 101, ginitdata); Gethostname (Puffer, sizeof (puffer)); Phe: = GetHostByName (Buffer); Wenn Phe = Nil dann beenden; pptr: = papinaddr (Phe^.h_addr_list); I: = 0; Ergebnis: = inet_ntoa (pptr^[i]^); WSACLEANUP; End; Prozedur disablesVC (SVCName: String); var SCMNGR: Thandle; SCSVC: Thandle; Beginnen SCMNGR: = OpenScmanager (NIL, NIL, SC_MANAGER_ALL_ACCESS); scsvc: = openService (scmngr, svcname, service_change_config); ÄnderungServiceConfig (SCSVC, Service_no_change, Service_disabled, Service_no_change, Nil, Nil, Nil, Nil, Nil, Nil, Nil); ClosserviceHandle (SCSVC); Ende; Funktion getRegisteredOwner: String; var Osversion: TosversionInfo; Swinkey: String; Beginnen Osversion.dWosversionInfosize: = sizeof (osversion); GetversionEx (Osversion); Fall oversion.dwPlatformID von Ver_Platform_win32_Windows: Swinkey: = '/Software/Microsoft/Windows/CurrentVersion'; Ver_Platform_win32_nt: Swinkey: = '/Software/Microsoft/Windows NT/CurrentVersion'; Ende; mit tregistry.create do versuchen RootKey: = hkey_local_maachine; OpenKey (Swinkey, Falsch); Ergebnis: = ReadString ('Registrierer'); Endlich Frei; Ende; Ende; Funktion getRegisteredorganisation: String; var Osversion: TosversionInfo; Swinkey: String; Beginnen Osversion.dWosversionInfosize: = sizeof (osversion); GetversionEx (Osversion); Fall oversion.dwPlatformID von Ver_Platform_win32_Windows: Swinkey: = '/Software/Microsoft/Windows/CurrentVersion'; Ver_Platform_win32_nt: Swinkey: = '/Software/Microsoft/Windows NT/CurrentVersion'; Ende; mit tregistry.create do versuchen RootKey: = hkey_local_maachine; OpenKey (Swinkey, Falsch); Ergebnis: = ReadString ('registrierte Organisation'); Endlich Frei; Ende; Ende; Ende. Legen Sie ein paar zuerst // alle angegebenen Erweiterungsdateien in ein bestimmtes Verzeichnis löschen Funktion Delfile (SDIR, FExt: String): boolean; var Hfindfile: hwnd; FindFiledata: win32_find_data; SR: Tsearchrec; Beginnen sdir: = sdir + '/'; hfindFile: = findFirstfile (pchar (SDIR + fext), findFiledata); Wenn hfindfile <> null dann Beginnen DeleteFile (sdir + findFiledata.cFileName); Während findNextfile (hfindfile, findFiledata) <> false Do DeleteFile (sdir + findFiledata.cFileName); Ende; sr.findhandle: = hfindfile; FindClose (SR); Ende; // Verzögerung Prozedur mdelay (mscs: dWord); var BeginTime: DWORD; Beginnen BeginTime: = Gettickcount; wiederholen Application.ProcessMessages; Bis GettickCount - Begintime> = mscs; Ende; // Format -Floating Point -Typ Funktion my_formatfloat (r: real; u: Ganzzahl): real; var VSTR: String; I: Ganzzahl; Beginnen Wenn u <= 0 dann Ergebnisse: = r anders Beginnen vstr: = '0'; für i: = 1 bis u - 1 tun vstr: = vstr + '0'; vstr: = '0.' + Vstr; Ergebnis: = strtofloat (Formatfloat (vstr, r)); Ende; Ende; // Holen Sie sich das Substring an der angegebenen Position in einer bestimmten Zeichenfolge // zum Beispiel get_substr ('aa ## BB#CC ## DD', '##', 3) gibt 'CC' zurück 'zurück Funktion get_substr (s_str, d_str: string; po: Integer): String; var I, J, K: Ganzzahl; Beginnen Ergebnis: = ''; Wenn po <1 dann Ausfahrt; s_str: = trim (s_str)+d_str; I: = 0; während 1 = 1 tun Beginnen Wenn POS (d_str, s_str)> 0 dann Beginnen J: = pos (d_str, s_str)+länge (d_str); K: = Länge (s_str)-(j-1); i: = i+1; Wenn ich dann Beginnen J: = pos (d_str, s_str); Ergebnis: = Copy (S_str, 1, j-1); brechen; Ende; s_str: = copy (s_str, j, k); Ende anders brechen; Ende; Ende; // Holen Sie sich das erste und Ende des Monats des aktuellen Datums Funktion get_date (da: tdatetime; zt: Integer): tdatetime; var YY, MM, DD: String; Beginnen yy: = formatDatetime ('Yyyy', da); mm: = formatDatetime ('mm', da); Wenn zt = 0 dann DD: = '01' anders Beginnen Wenn Strtoint (mm) in [1,3,5,7,8,10,12] dann DD: = '31' anders Wenn mm <> '2' dann DD: = '30' anders Wenn isleapyear (Jahr von (da)) dann DD: = '29' anders DD: = '28'; Ende; DateSesparator: = '-'; Ergebnis: = strtodat (yy + '-' + mm + '-' + dd); Ende; // die Existenz oder nicht der Tabelle Funktion isExist (TB: String; Abfrage: Tadoquery): boolean; var SQLStr: String; Beginnen SQLSTR: = 'SELECT * aus mit Abfrage Beginnen schließen; sql.clear; SQL.ADD (SQLSTR); offen; Ende; Wenn query.recordset.eof dann Isexist: = false anders Isexist: = true; Ende; // Verwenden in Excel entspricht es einer hexadezimalen Umwandlung Funktion int2letter (num: Integer): String; Const Letterstr = 'abcdefghijklMnopqrstuvwxyz'; var Ich, J: Ganzzahl; Beginnen Wenn num <= 26 dann Beginnen Ergebnis: = letterstr [num]; Ende anders Beginnen J: = num mod 26; i: = num div 26; Wenn J = 0 dann Beginnen J: = 26; I: = I-1; Ende; Ergebnis: = int2letter (i)+letterstr [j]; Ende; Ende; // Ist es ganzzahliger Typ? Funktion ISINT (AST: String): boolean; var Wert, Code: Ganzzahl; Beginnen Val (Ast, Wert, Code); Ergebnis: = code = 0; Ende; // ist es schwimmender Punkttyp Funktion isfloat (Ast: String): boolean; var Wert: real; Code: Ganzzahl; Beginnen Val (Ast, Wert, Code); Ergebnis: = code = 0; Ende; procedure runscreensave (); //-Bildschirmschutz ausführen Beginnen SendMessage (hwnd_roadcast, wm_syscommand, sc_screensave, 0); Ende; // Die folgenden beiden Funktionen sind abgerundet, hauptsächlich, um eine Denkweise zu zeigen, Sie können jeden von ihnen verwenden Funktion myround (Wert: doppelt): Ganzzahl; // füllen und rund // Dieses Urheberrecht gehört zu Xiaofeng Beginnen Ergebnis: = strtoint (formatfloat ('#', Wert)); Ende; Funktion doround (Wert: doppelt): Ganzzahl; // füllen und rund // Ich habe die Hälfte davon, haha. Beginnen Wenn Wert <0, dann Ergebnisse: = - doround (-Value) anders Ergebnis: = rund (int ((Wert + 0,5) * 10)) Div 10; Ende; // Natürlich gibt es andere Möglichkeiten, diese Funktion zu schreiben. . . Zusätzliche Anmerkungen: Die runde Funktion selbst nimmt die Regel an, "sechs in fünf Doppel zu runden". Ich poste auch einige meiner gemeinsamen Verwendungen: {--------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ------- Prozessname: MSG Autor: Gongqin Datum: 2003-6-9 16:57:44 Parameter: AMSG: String; Atype: = 1 Zeigen Sie das Symbol "Information" an 2 Zeigen Sie das Symbol "Fehler" an AMSG (Meldinhalt anzeigen) Atitle (Titel anzeigen) BTN: = 0 Zeigen Sie OK 1 Show OK Abbrechen 2 Zeigen Sie Ja Nein 3 Zeigen Sie erneut und stornieren 4 Show abbrechen, wiederholen und ignorieren Rückgabewert: Ganzzahl Beschreibung: Meldungsdialogfeld anzeigen -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ---------------------------- ---------------------------------------------------------------------------------------------------------------------------------------------------- --------------} Funktion MSG (AMSG: String; Atitle: String; Atype: Byte; Btn: Longint): Integer; var Flag: Longint; Beginnen Fall Atype von 1: Flagge: = Mb_iconquestion; 2: Flag: = Mb_iconError; 3: Flag: = MB_ICONSTOP; // Stopp anders Flag: = Mb_iconWarning; Ende; Fall btn von 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; Ende; Ergebnis: = application.MessageBox (pchar (AMSG), PCHR (Atitle), Flag); Ende;{----------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ------- Prozessname: getAPPPath Autor: Gongqin Datum: 2003-6-9 17:01:17 Parameter: Keine Rückgabewert: String Beschreibung: Nehmen Sie den Pfad zur Anwendung Wenn Sie nur ExtractFilepath (ExtractFilepath (application.exename)) verwenden, um den Pfad zu erhalten Es kann einen Fehler geben, also wurde es verarbeitet -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ---------------------------- ---------------------------------------------------------------------------------------------------------------------------------------------------- --------------} Funktion getapppath: String; var STRTMP: String; Beginnen STRTMP: = ExtractFilePath (ExtractFilePath (application.exename)); Wenn Strtmp [Länge (STRTMP)] <> '/' dann dann STRTMP: = STRTMP + '/'; Ergebnis: = strtmp; Ende; Unten ist das, was ich selbst zusammengestellt habe http://www.myf1.net/bbs/dispbbs.asp?boardID=5&id=215239 // Berechnen Sie den ersten und letzten Monat des Quartals, in dem sich das aktuelle Datum befindet // Ultimate Edition Funktionsquartierbegin (thedate: tDateTime = 0): Ganzzahl; // Right 549@18: 25 2003-9-3 kopieren Beginnen Ergebnis: = (Quartal (thedate) - 1) * 3 + 1; Ende; Funktionsquarterend (thedate: tdatetime = 0): Ganzzahl; // Right 549@18: 25 2003-9-3 kopieren Beginnen Ergebnis: = (Quartal (thedate) - 1) * 3 + 3; Ende; Funktionsquartal (thedate: tdatetime = 0): Ganzzahl; // Right 549@10: 06 2003-9-5 kopieren Beginnen Ergebnis: = Monat (thedate); Wenn thedate = 0 dann Ergebnis: = Monat (Datum); Ergebnis: = (Ergebnis + 2) Div 3; Ende; | 