| function getKBStatus (): string; // Regresar al estado del teclado actual, incluyendo Numloce, BLOQUEO, INSERTO // Cada información de estado ocupa dos caracteres, en el orden: numloce, bloqueo de tapas, inserción // Copiar a la derecha 549@11: 29 2003-7-22 estado var: cadena; Keystates: TkeyboardState; Comenzar GetKeyboardState (KeyStates); Si impar (KeyStates [VK_NUMLOCK]) entonces Estado: = 'número' demás Estado: = 'cursor'; Si impar (KeyStates [VK_Capital]) entonces Estado: = Estado+'Caps' demás Estado: = estado+'minúscula'; Si impar (KeyStates [VK_INSERT]) entonces Estado: = estado+'insertar' demás Estado: = estado+'reescribir'; Resultados: = estado; fin; const errhead = 'El error ocurrió en la operación, el mensaje de error es:'+#13 intentar ... excepto En E: Exception do ShowMessage (errhead+E.Message+#13+'La operación actual es: xxxxx'); fin; Permite a los usuarios ver más mensajes de error, lo que ayuda a los errores del programa de retroalimentación de los clientes. Escribo una buena idea, pero a menudo la uso: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>> // ejecutar sql // Parámetros de entrada: SQLString, Adoquery // escribe: cadena, tadoQuery Procedimiento tmainform.exesql (SQLString: String; Adoquery: TadoQuery); Comenzar con Adoquery Do Comenzar Conexión: = dm.dbaccinfo; // Esto es mío, puedes agregar la conexión // o usarlo. Si está activo entonces Activo: = falso; Abierto; Sql.clear; Sql.add (sqlstring); Ejecutsql; Cerca; fin; fin; Sin embargo, en el código que he visto, parece que pocas personas escriben un proceso tan independiente. Esto se garantiza que será original por mí mismo ... // Abra la Adaquery // adaptado del proceso de verdad (Aixiang (solo se puede decir a Lizzy que otros no pueden)) // admite SQL de múltiples líneas // Puede modificarlo usted mismo según sea necesario para admitir solo procedimientos SQL de una sola línea o procedimientos EXESQL // La prueba bajo Delphi6 pasó. Procedimiento OpenSQL (SQLString: TStrings; Adoquery: TadoQuery); var i: entero; Comenzar con Adoquery Do Comenzar Cerca; Sql.clear; para i: = 0 a sqlstring.count-1 do Sql.add (sqlstring [i]); intentar Abierto; excepto En E: Exception do showMessage ('Error: el mensaje es el siguiente'#13+e.message); fin; fin; fin; Esta es una sola línea de SQL procedimiento OpenSQL1 (SQLString: String; Adoquery: TadoQuery); Comenzar con Adoquery Do Comenzar Cerca; Sql.clear; Sql.add (sqlstring); intentar Abierto; excepto En E: Exception do showMessage ('Error: el mensaje es el siguiente'#13+e.message); fin; fin; fin; Hoho, gracias por ayudarme a arreglar esto. ¿Pero no usas EXECSQL? Por lo general, agrego intento fuera de este proceso, es decir, donde se le cita. Eso es intentar EXESQL (SQLString, Adoquery1) excepto // Solicitud de error, cosas desordenadas. fin TO: Real (Aixiang (solo a Lizzy se le puede decir que otros no pueden)) Yo también hice ejecutsql // ejecutsql Adoquery // admite SQL de múltiples líneas // Puede modificarlo usted mismo según sea necesario para admitir solo procedimientos SQL de una sola línea o procedimientos EXESQL // La prueba bajo Delphi6 pasó. procedimiento exesql (sqlstring: tstrings; Adoquery: tadoQuery); var i: entero; Comenzar con Adoquery comience Cerca; Sql.clear; para i: = 0 a sqlstring.count-1 do Sql.add (sqlstring [i]); intentar Ejecutsql; excepto En E: Exception do showMessage ('Error: el mensaje es el siguiente'#13+e.message); fin; fin; fin; // Creo que es lo mismo donde se coloca, es mejor ponerlo afuera porque puede agregar alguna otra información de depuración //¿Qué opinas? // ¿Cualquiera está combinado los dos procesos para ejecutar una sola línea y ejecutar múltiples líneas en una, eso sería genial? Haré dos más, y puedo agregarlos y eliminarlos de acuerdo con mis necesidades, pero estoy usando dbgrideh para crear dinámicamente col. procedimiento buildCol (vfieldName: string; vcaption: string; vwidth: integer; var VGRID: TDBGRIDEH; FooterType: tfootervalueType = fvtnon; boolreadonly: boolean = true; varilla CCOL: TDBGridcolumneh; CfooterCol: tcolumnfootereh; Comenzar 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; // Si el valor de la etiqueta es -1, la columna no se imprimirá al imprimir DBGRID ccol.tag: = itag; Comenzar cfootercol: = ccol.footers.add; cfootercol.valuetype: = footerType; Si footerType = fvtstatextext entonces Comenzar vgrid.footRowrowCount: = 1; cfooterCol.Value: = FootText; fin; //ccol.footer.fieldname:=; fin; end; procedimiento titleBtnClick (remitente: tobject; acol: integer; Columna: tcolumneh; varilla CDSTMP: TClientDataSet; Comenzar con (remitente como tdbgrideh) hacer Comenzar cdstmp: = (dataSource.dataSet como tclientdataset); Si no es CDSTMP.Active, entonces salga; // Establecer el método de clasificación de la fila actual if column.title.sortmarker = smnoneeh entonces Comenzar Column.title.sortmarker: = smupeh; cdshelper.sortbyfield (column.fieldname, Soascending); fin demás if column.title.sortmarker = smupeh entonces Comenzar Column.title.sortmarker: = smdoweh; CDSHELPER.SORTBYFIELD (column.fieldname, sodescending); fin demás Comenzar Column.title.sortmarker: = smnoneeh; CDSHELPER.SORTBYFIELD (column.fieldname, Sonosort); fin; fin; fin; procedimiento f_readini (const Now_dbgrid: tdbgrid; form_name: string); varilla Filepath: cadena; Myinifile: tinifile; Grid_name, field_name: string; Ancho: entero; I, J, N: entero; Columna: matriz [0..100] de cadena; Anchos: matriz [0..100] de entero; Comenzar FilePath: = ExtractFilePath (Application.exename); Myinifile: = tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+ahora_dbgrid.name; n: = ahora_dbgrid.columns.count-1; para i: = 0 a n hacer Comenzar Field_name: = now_dbgrid.columns [i] .fieldname; j: = myInifile.ReadInteger (Grid_name, field_name, i); Columna [j]: = field_name; Anchos [j]: = myInifile.ReadInteger (Grid_name, Field_Name+'_ Width', Now_dbgrid.Columns [i] .Width); fin; Comenzar Ahora_dbgrid.columns [i] .FieldName: = columna [i]; Ahora_dbgrid.columns [i] .Width: = widhs [i]; fin; end; procedimiento f_writeini (const Now_dbgrid: tdbgrid; form_name: string); varilla Filepath: cadena; Myinifile: tinifile; Grid_name, field_name: string; Ancho: entero; I: entero; Comenzar FilePath: = ExtractFilePath (Application.exename); Myinifile: = tinifile.create (filepath+'gsp.ini'); Grid_name: = form_name+','+ahora_dbgrid.name; Comenzar Field_name: = now_dbgrid.columns [i] .fieldname; Ancho: = ahora_dbgrid.columns [i] .Width; MyInifile.WriteInteger (Grid_Name, Field_Name, I); MyInifile.WriteInteger (Grid_Name, Field_Name+'_ Width', Width); fin; fin; Unidad myFunc; interfaz usos Windows, Sysutils, MMSystem, WinsVC, Registry; Function CopystrLleft (CH: Char; Str: String): String; función copystrright (ch: char; str: string): string; función getSelfpath: string; Procedimiento HidetaSk (Bhide: Boolean); Función SoundCardinstalled: Boolean; función gethostip: string; procedimiento DisableVC (svcName: string); function getRegisteredOwner: String; Función GetRegisterRanganization: String; Comenzar Resultados: = copia (Str, 1, Pos (CH, Str) -1) end; function Copystrright (ch: char; str: string): string; Comenzar Resultados: = Copy (Str, Pos (CH, Str) +1, Longitud (Str) -pos (CH, Str) +1) end; función getSelfpath: string; Comenzar Resultado: = ExtractFilePath (Paramstr (0)) final; procedimiento HidetaSk (bhide: boolean); Comenzar Si Bhide entonces RegisterServiceProcess (GetCurrentProcessid, 1) else RegisterServiceProcess (GetCurrentProcessid, 0); End; Function SoundCardinstalled: boolean; Comenzar Resultado: = WaveOutgetNumdevs> 0 end; función gethostip: string; tipo Tapinaddr = array [0..10] de pinaddr; Papinaddr = ^tapinaddr; varilla Phe: Phostent; PPTR: PAPINADDR; Búfer: matriz [0..63] de char; I: entero; Ginitdata: twsadata; Comenzar WSASTARTUP ($ 101, ginitdata); GethostName (búfer, sizeOf (buffer)); phe: = gethostByName (buffer); Si phe = nil entonces salga; pptr: = papinaddr (phe^.h_addr_list); I: = 0; Resultado: = inet_ntoa (pptr^[i]^); Wsacleanup; End; Procedimiento DisableVC (SVCName: String); varilla SCMNGR: Thandle; SCSVC: Thandle; Comenzar scmngr: = opensCmanager (nil, nil, sc_manager_all_access); scSvc: = OpenService (scmngr, svcname, servicio_change_config); ChogiesServiceConFig (SCSVC, Servicio_no_change, Servicio_disable, Servicio_no_change, nulo, nulo, nulo, nulo, nulo, nulo, nulo); CloseServiceHandle (SCSVC); end; function getRegisteredOnder: String; varilla Osversion: TosversionInfo; Swinkey: cadena; Comenzar OSVERSION.DWOSVERSIONInfosize: = sizeof (Osversion); GetVersionEx (Osversion); case osversion.dwplatformid de Ver_platform_win32_windows: swinkey: = '/software/Microsoft/Windows/CurrentVersion'; Ver_platform_win32_nt: swinkey: = '/software/Microsoft/Windows NT/CurrentVersion'; fin; con Tregumistry.Create do intentar Key Key: = HKEY_LOCAL_MACHINE; OpenKey (Swinkey, falso); Resultado: = readString ('RegistroDearter'); Finalmente Gratis; fin; end; function getRegisterEdorganization: String; varilla Osversion: TosversionInfo; Swinkey: cadena; Comenzar OSVERSION.DWOSVERSIONInfosize: = sizeof (Osversion); GetVersionEx (Osversion); case osversion.dwplatformid de Ver_platform_win32_windows: swinkey: = '/software/Microsoft/Windows/CurrentVersion'; Ver_platform_win32_nt: swinkey: = '/software/Microsoft/Windows NT/CurrentVersion'; fin; con Tregumistry.Create do intentar Key Key: = HKEY_LOCAL_MACHINE; OpenKey (Swinkey, falso); Resultado: = ReadString ('RegistroDorganization'); Finalmente Gratis; fin; fin; fin. Coloque algunos primero // eliminar todos los archivos de extensión especificados en un directorio determinado function delfile (sdir, fext: string): boolean; varilla hfindfile: hwnd; Findfiledata: win32_find_data; SR: TSearchRec; Comenzar sdir: = sdir + '/'; hfindfile: = findFirstFile (pChar (SDIR + fext), findfiledata); Si hfindfile <> nulo entonces Comenzar deletefile (SDIR + findfiledata.cfileName); mientras que findNextFile (hfindFile, findFiledata) <> falso do deletefile (SDIR + findfiledata.cfileName); fin; Sr.findHandle: = HfindFile; FindClose (SR); final ;/ procedimiento mdelay (msecs: dword); varilla Begintime: dword; Comenzar BegIntime: = getTickCount; repetir Aplicación. ProcessMessages; Hasta GetTickCount - Begintime> = msecs; Fin; // Formato de tipo de punto flotante función my_formatfloat (r: real; u: entero): real; varilla VSTR: String; I: entero; Comenzar Si u <= 0 entonces Resultados: = R demás Comenzar VSTR: = '0'; para i: = 1 a u - 1 VSTR: = VSTR + '0'; VSTR: = '0.' Resultado: = strtofloat (formatfloat (vstr, r)); fin; end; // Obtenga la subcadena en la posición especificada en una determinada cadena // Por ejemplo, get_substr ('aa ## bb#cc ## dd', '##', 3) Devuelve 'cc' función get_substr (s_str, d_str: string; po: entero): string; varilla I, J, K: entero; Comenzar resultado: = ''; Si po <1 entonces salida; S_STR: = TRIM (S_STR)+D_STR; i: = 0; Mientras que 1 = 1 lo hace Comenzar Si pos (d_str, s_str)> 0 entonces Comenzar j: = pos (d_str, s_str)+longitud (d_str); k: = longitud (s_str)-(j-1); i: = i+1; Si yo = po entonces Comenzar j: = pos (d_str, s_str); resultado: = copia (S_STR, 1, J-1); romper; fin; S_STR: = COPY (S_STR, J, K); fin demás romper; fin; finalizar; // Obtenga el primero y el final del mes de la fecha actual function get_date (da: tdateTime; zt: entero): tdateTime; varilla yy, mm, dd: cadena; Comenzar yy: = formatDateTime ('aaa yyy', da); mm: = formatDateTime ('mm', da); Si zt = 0 entonces DD: = '01' demás Comenzar Si strToint (mm) en [1,3,5,7,8,10,12] entonces DD: = '31' demás Si mm <> '2' entonces DD: = '30' demás if isleapyear (añof (da)) entonces DD: = '29' demás dd: = '28'; fin; DateseParator: = '-'; resultado: = strtodate (yy + '-' + mm + '-' + dd); fin; // la existencia o no de la tabla función isExist (tb: string; consulta: tadoQuery): boolean; varilla sqlstr: string; Comenzar sqlstr: = 'select * de sysObjects donde id = object_id (' '+tb+' '') '; con consulta hacer Comenzar cerca; sql.clear; SQL.Add (SQLSTR); abierto; fin; if query.recordset.eof entonces Isexist: = falso demás IsExist: = true; fin; // use en Excel, es equivalente a la conversión hexadecimal función int2letter (num: entero): string; estúpido Letrastr = 'abcdefghijklmnopqrstuvwxyz'; varilla I, J: entero; Comenzar Si num <= 26 entonces Comenzar Resultado: = letrastr [num]; fin demás Comenzar j: = num mod 26; i: = num div 26; Si j = 0 entonces Comenzar J: = 26; i: = i-1; fin; resultado: = int2letter (i)+letrastr [j]; fin; end; // es un tipo entero función isInt (AST: String): boolean; varilla Valor, código: entero; Comenzar Val (astr, valor, código); Resultado: = código = 0; fin; // ¿Es el tipo de punto flotante? función isfloat (astr: string): boolean; varilla Valor: real; Código: Integer; Comenzar Val (astr, valor, código); Resultado: = código = 0; fin; procedimiento runScreensave (); //-Ejecutar la protección de la pantalla Comenzar SendMessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0); fin; // Las siguientes dos funciones son redondeadas, principalmente para mostrar una forma de pensar, puede usar cualquiera de ellas función myround (valor: doble): integer; // llenar y redondo // Este derecho de autor pertenece a Xiaofeng Comenzar resultado: = strToint (formatfloat ('#', valor)); end; function doround (valor: doble): entero; // llenar y redondo // Tengo la mitad de esto, jaja. Comenzar if valor <0 entonces resultados: = - doround (-value) demás Resultado: = redonde (int ((valor + 0.5) * 10)) div 10; fin; // Por supuesto, hay otras formas de escribir esta función. . . Notas adicionales: La función redonda en sí adopta la regla de "redondear seis en cinco dobles". También publico algunos de mis usos comunes: {------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------ Nombre del proceso: MSG Autor: Gongqin Fecha: 2003-6-9 16:57:44 Parámetros: amsg: string; Atype: = 1 Muestra el icono de "información" 2 Muestra el icono de "error" AMSG (Contenido de mensaje de visualización) atitle (título de visualización) btn: = 0 show ok 1 show ok cancelar 2 Mostrar si no 3 Mostrar reintento y cancelar 4 show abort, volver a intentarlo e ignorar Valor de retorno: entero Descripción: Made de diálogo Muestra de mensaje de visualización -------------------------------------------------- -------------------------------------------------- ---------------------------- ---------------------- --------------} función msg (amsg: string; atitle: string; atype: byte; btn: longint): integer; bandera var: longint; Comenzar Caso de tipo de 1: bandera: = MB_ICONQUEST; // Haga una pregunta 2: Flag: = MB_IConError; 3: Flag: = MB_ICONSTOP; demás Bandera: = mb_iconwarning; fin; caso btn de 0: bandera: = bandera + mb_ok; 1: bandera: = bandera + mb_okcancel; 2: bandera: = bandera + mb_yesno; 3: bandera: = bandera + mb_yesnocancel; 4: Flag: = Flag + MB_RetryCancel; 5: Flag: = Flag + MB_AborretryIignore; fin; Resultado: = Application.MessageBox (PCHAR (AMSG), PCHAR (ATITLE), FLAG); fin;{----------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- -------------------------------------------------- ------ Nombre del proceso: GetApppath Autor: Gongqin Fecha: 2003-6-9 17:01:17 Parámetros: ninguno Valor de retorno: cadena Descripción: Tome el camino a la aplicación Si solo usa ExtractFilePath (ExtractFilePath (Application.exename)) para obtener la ruta Puede haber un error, por lo que fue procesado -------------------------------------------------- -------------------------------------------------- ---------------------------- ---------------------- --------------} función getAppPath: string; varilla strtmp: string; Comenzar strtmp: = ExtractFilePath (ExtractFilePath (Application.exename)); Si strtmp [longitud (strtmp)] <> '/' entonces entonces strtmp: = strtmp + '/'; resultado: = strtmp; fin; A continuación se muestra lo que me he compilado http://www.myf1.net/bbs/dispbbs.asp?boardid=5&id=215239 // Calcule el primer y el mes pasado del trimestre donde se encuentra la fecha actual // edición definitiva function Quarterbegin (thedate: tDateTime = 0): integer; // Copiar a la derecha 549@18: 25 2003-9-3 Comenzar Resultado: = (cuarto (thedate) - 1) * 3 + 1; end; function Quarterend (thedate: tDateTime = 0): integer; // Copiar a la derecha 549@18: 25 2003-9-3 Comenzar Resultado: = (trimestre (thedate) - 1) * 3 + 3; End; Function Quarter (thedate: tDateTime = 0): integer; // Copiar a la derecha 549@10: 06 2003-9-5 Comenzar Resultado: = mesOf (thedate); si thedate = 0 entonces resultado: = mesOf (fecha); Resultado: = (resultado + 2) Div 3; fin; | 