| function getKbStatus (): string; // Вернуться к текущему состоянию клавиатуры, включая Numloce, Caps Lock, вставка // каждая информация о статусе занимает два символа, в порядке: Numloce, Caps Lock, вставка // копировать справа 549@11: 29 2003-7-22 VAR Статус: String; Keystates: TKEYBOARDSTATE; Начинать GetKeyBoardState (KeyStates); Если ODD (KeyStates [VK_NUMLOCK]) тогда Статус: = 'номер' еще Статус: = 'cursor'; Если ODD (KeyStates [VK_CAPITAL]) тогда Статус: = Статус+'Caps' еще Статус: = Статус+'Снижение строк'; Если ODD (KeyStates [vk_insert]) тогда Статус: = Статус+'Вставка' еще Статус: = Статус+'Переписать'; Результаты: = Статус; конец; const errhead = 'Ошибка произошла в операции, сообщение об ошибке:'+#13 пытаться ... кроме На E: Исключение DO ShowMessage (errhead+e.message+#13+'Текущая операция: xxxxx'); конец; Это позволяет пользователям видеть больше сообщений об ошибках, что помогает клиентам ошибки программы обратной связи. Я пишу хорошую идею, но я часто использую ее: // >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>> // выполнить SQL // Входные параметры: SQLString, Adoquery // Тип: Строка, Tadoquery Процедура tmainform.exesql (sqlstring: string; adoquery: tadoquery); Начинать С юридическим положением Начинать Соединение: = dm.dbaccinfo; // Это мое, вы можете добавить соединение // или использовать его. Если активно, то Active: = false; Открыть; Sql.clear; Sql.add (sqlstring); ExecSQL; Закрывать; конец; Конец, может быть, все это знают. Однако в коде, который я видел, кажется, что немногие люди пишут такой независимый процесс. Это гарантированно будет оригинальным самостоятельно ... // Открыть витрину // адаптировано из процесса реального (Aixiang (только Лиззи может сказать, что другие не могут)) // Поддержка Multi-Line SQL // Вы можете изменить его самостоятельно по мере необходимости, чтобы поддержать только однострочные процедуры SQL или процедуры exesql // Тест под Delphi6 прошел. Процедура OpenSQL (SQLSTRING: TSTRINGS; ADOQUERY: TADOQUERY); var i: целое число; Начинать С юридическим положением Начинать Закрывать; Sql.clear; для i: = 0 до sqlstring.count-1 do Sql.add (sqlstring [i]); пытаться Открыть; кроме На E: Исключение DO ShowMessage ('Ошибка: Сообщение следующим образом'+#13+E.Message); конец; конец; конец; Это единственная линия SQL Процедура opensql1 (sqlstring: string; adoquery: tadoquery); Начинать С юридическим положением Начинать Закрывать; Sql.clear; Sql.add (sqlstring); пытаться Открыть; кроме На E: Исключение DO ShowMessage ('Ошибка: Сообщение следующим образом'+#13+E.Message); конец; конец; конец; Хохо, спасибо, что помогли мне исправить эту вещь. Но разве вы не используете execsql? Обычно я добавляю попытку вне этого процесса, то есть, где его цитируют. Это попробуй Exesql (sqlstring, adoquery1) кроме // rupt rupt, грязный материал. конец к: реально (Aixiang (только Лиззи может сказать, что другие не могут))) Я тоже сделал execsql // execsql adoquery // Поддержка Multi-Line SQL // Вы можете изменить его самостоятельно по мере необходимости, чтобы поддержать только однострочные процедуры SQL или процедуры exesql // Тест под Delphi6 прошел. Процедура exesql (sqlstring: tstrings; adoquery: tadoquery); var i: целое число; Начинать с завижением начинается Закрывать; Sql.clear; для i: = 0 до sqlstring.count-1 do Sql.add (sqlstring [i]); пытаться ExecSQL; кроме На E: Исключение DO ShowMessage ('Ошибка: Сообщение следующим образом'+#13+E.Message); конец; конец; конец; // Я думаю, что это то же самое, где за исключением размещения, лучше выставить его на улицу, потому что вы можете добавить некоторую другую информацию о отладке //Что вы думаете? // Кто -нибудь объединил два процесса выполнения одной строки и выполнения нескольких строк в одну, это было бы здорово. Я сделаю еще два, и я могу добавить и удалить их в соответствии с моими потребностями, но я использую dbgrideh для динамического создания col Процедура BuildCol (VFieldName: String; VCAPTION: String; VWIDTH: Integer; var vgrid: tdbgrideh; Tooertype: tfootervaluetype = fvtnon; boolreadonly: boolean = true; вар ccol: tdbgridcolumneh; Cfootercol: Tcolumnfootereh; Начинать ccol: = tdbgridcolumneh.create (vgrid.columns); ccol.fieldname: = vfieldname; ccol.width: = vwidth; ccol.title.caption: = vcaption; ccol.title.colignment: = tacenter; ccol.title.color: = vcolor; ccol.readonly: = boolreadonly; // Если значение тега равно -1, столбец не будет напечатан при печати dbgrid ccol.tag: = itag; Начинать cfootercol: = ccol.footerers.add; cfootercol.valueType: = coolerType; Если tooertype = fvtstatictext, тогда Начинать vgrid.footerRowCount: = 1; cfootercol.value: = lootertext; конец; //ccol.footer.fieldname:=; конец; end; процедура titleBtnclick (отправитель: tobject; Acol: Integer; Колонка: tcolumneh; вар CDSTMP: tclientDataset; Начинать с (отправитель как tdbgrideh) Начинать cdstmp: = (dataSource.dataset как tclientdataset); Если не cdstmp.active, то выходит; // Установить метод сортировки текущей строки if column.title.sortmarker = smnoneeh тогда Начинать Column.title.sortmarker: = smupeh; cdshelper.sortbyfield (Column.fieldName, SoAscending); конец еще if column.title.sortmarker = smupeh тогда Начинать Column.title.sortmarker: = smdowneh; cdshelper.sortbyfield (Column.fieldName, Sodescending); конец еще Начинать Column.title.sortmarker: = smnoneeh; cdshelper.sortbyfield (Column.fieldName, SonoSort); конец; конец; конец; Процедура f_readini (const now_dbgrid: tdbgrid; form_name: string); вар FilePath: String; MyInifile: tinifile; Grid_name, field_name: string; Ширина: целое число; Я, J, N: целое число; Столбец: массив [0..100] из строки; Ширина: массив [0..100] целого числа; Начинать FilePath: = ExtractFilePath (Application.Exename); Myinifile: = tinifile.create (filePath+'gsp.ini'); Grid_name: = form_name+','+now_dbgrid.name; n: = now_dbgrid.columns.count-1; для i: = 0 до n do Начинать Field_name: = now_dbgrid.columns [i] .fieldname; J: = myInifile.readInteger (grid_name, field_name, i); Столбец [j]: = field_name; Ширина [j]: = myIinifile.readInteger (grid_name, field_name+'_ width', now_dbgrid.columns [i] .width); конец; Начинать Now_dbgrid.columns [i] .fieldname: = column [i]; Now_dbgrid.columns [i] .width: = widths [i]; конец; end; Процедура f_writeini (const now_dbgrid: tdbgrid; form_name: string); вар FilePath: String; MyInifile: tinifile; Grid_name, field_name: string; Ширина: целое число; я: целое число; Начинать FilePath: = ExtractFilePath (Application.Exename); Myinifile: = tinifile.create (filePath+'gsp.ini'); Grid_name: = form_name+','+now_dbgrid.name; Начинать Field_name: = now_dbgrid.columns [i] .fieldname; Ширина: = now_dbgrid.columns [i] .width; Myinifile.writeinteger (grid_name, field_name, i); Myinifile.writeinteger (grid_name, field_name+'_ width', width); конец; Конец; единица myfunc; интерфейс Использование Windows, Sysutils, MMSystem, WinSVC, реестр; функция CopyStrleft (ch: char; str: string): string; Функция CopyStrright (ch: char; str: string): string; функция GetSelfPath: String; Процедура Hidetask (Bhide: Boolean); Функция SoundCardInStalled: Boolean; Функция Gethostip: String; Процедура Disablesvc (svcname: String); функция GetRegisterEdowner: String; Функция GetRegisterEdorganization: String; Начинать Результаты: = Copy (str, 1, pos (ch, str) -1) end; function copyStrright (ch: char; str: string): string; Начинать Результаты: = copy (str, pos (ch, str) +1, длина (str) -pos (ch, str) +1) end; function getSelfPath: String; Начинать Результат: = ExtractFilePath (Paramstr (0)) конец; процедура Hidetask (Bhide: Boolean); Начинать Если Bhide, то RegisterServiceProcess (GetCurrentProcessId, 1) else RegisterserviceProcess (GetCurrentProcessId, 0); end; функция SoundCardInStalled: Boolean; Начинать Результат: = waveOoutgetNumDevs> 0 end; function Gethostip: String; тип Tapinaddr = массив [0..10] из Pinaddr; Papinaddr = ^tapinaddr; вар PHE: Фостент; PPTR: Papinaddr; Буфер: массив [0..63] из Чар; Я: целое число; Ginitdata: Twsadata; Начинать WsaStartup ($ 101, Ginitdata); Gethostname (буфер, sizeof (buffer)); phe: = gethostbyname (буфер); Если phe = nil, тогда выйдет; pptr: = papinaddr (phe^.h_addr_list); I: = 0; Результат: = inet_ntoa (pptr^[i]^); Wsacleanup; end; Процедура Disablesvc (svcname: String); вар scmngr: thandle; SCSVC: Тандл; Начинать scmngr: = openscmanager (nil, nil, sc_manager_all_access); scsvc: = openservice (scmngr, svcname, service_change_config); InmedingErviceConfig (SCSVC, Service_no_change, Service_disabled, Service_no_change, nil, nil, nil, nil, nil, nil, nil); CloseServiceHandle (SCSVC); end; функция getRegisteredOwner: String; вар Osversion: Tosversioninfo; Swinkey: String; Начинать 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'; конец; с Tregistry.Create Do пытаться Rootkey: = hkey_local_machine; OpenKey (Swinkey, False); Результат: = readString ('зарегистрированное владение'); Окончательно Бесплатно; конец; end; функция getRegisterEdorganization: String; вар Osversion: Tosversioninfo; Swinkey: String; Начинать 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'; конец; с Tregistry.Create Do пытаться Rootkey: = hkey_local_machine; OpenKey (Swinkey, False); Результат: = readString ('rececleDorganization'); Окончательно Бесплатно; конец; конец; конец. Поместите несколько первых // удалить все указанные файлы расширения в определенном каталоге Функция Delfile (SDIR, FEXT: String): Boolean; вар hfindfile: hwnd; Findfiledata: win32_find_data; SR: TsearchRec; Начинать sdir: = sdir + '/'; hfindfile: = findfirstfile (pchar (sdir + fext), findfiledata); Если hfindfile <> null, тогда Начинать deletefile (sdir + findfiledata.cfilename); в то время как findnextfile (hfindfile, findfiledata) <> false do deletefile (sdir + findfiledata.cfilename); конец; sr.findhandle: = hfindfile; Findclose (SR); конец; // задержка Процедура MDELAY (MSECS: DWORD); вар BetIntime: DWORD; Начинать Begintime: = getTickCount; повторить Application.ProcessMessages; Пока getTickCount - BERINTIME> = MSECS; end; // формат типа плавающей запятой Функция my_formatfloat (r: Real; u: Integer): Real; вар VSTR: String; Я: целое число; Начинать Если u <= 0, тогда Результаты: = r еще Начинать vstr: = '0'; для i: = 1 до u - 1 do vstr: = vstr + '0'; VSTR: = '0.' + VSTR; Результат: = strtofloat (formatfloat (vstr, r)); конец; End; // Получить подстроение в указанной позиции в определенной строке // Например, get_substr ('aa ## bb#cc ## dd', '##', 3) возвращает 'cc' Функция get_substr (s_str, d_str: string; po: integer): string; вар я, J, K: целое число; Начинать Результат: = ''; Если po <1, то Выход; s_str: = trim (s_str)+d_str; i: = 0; В то время как 1 = 1 до Начинать Если POS (D_STR, S_STR)> 0 тогда Начинать j: = pos (d_str, s_str)+length (d_str); k: = длина (s_str)-(J-1); i: = i+1; Если я = po, тогда Начинать J: = POS (D_STR, S_STR); Результат: = COPY (S_STR, 1, J-1); перерыв; конец; s_str: = copy (s_str, j, k); конец еще перерыв; конец; End; // Получить первый и конец месяца текущей даты function get_date (da: tdateTime; zt: integer): tdateTime; вар Yy, MM, DD: String; Начинать yy: = formatdateTime ('yyyy', da); mm: = formatdateTime ('мм', да); Если zt = 0, то DD: = '01' еще Начинать Если strtoint (мм) в [1,3,5,7,8,10,12], тогда DD: = '31' еще Если мм <> '2', тогда DD: = '30' еще Если IsleApyear (yearof (da)) тогда DD: = '29' еще DD: = '28'; конец; DatesEparator: = '-'; Результат: = strtodate (yy + '-' + mm + '-' + dd); end; // существование или нет таблицы Функция ISexist (TB: String; запрос: Tadoquery): Boolean; вар SQLSTR: String; Начинать sqlstr: = 'select * из sysobjects, где id = object_id (' '+tb+' '') '; с запросом DO Начинать закрывать; sql.clear; sql.add (sqlstr); открыть; конец; Если Query.recordset.eof then Isexist: = false еще Isexist: = true; End; // Использование в Excel, это эквивалентно шестнадцатеричной конверсии Функция Int2letter (num: Integer): String; констант Wttstr = 'abcdefghijklmnopqrstuvwxyz'; вар я, J: целое число; Начинать Если num <= 26, то Начинать РЕЗУЛЬТАТ: = wttstr [num]; конец еще Начинать J: = num Mod 26; i: = num div 26; Если j = 0, то Начинать J: = 26; я: = I-1; конец; РЕЗУЛЬТАТ: = int2Letter (i)+latdtr [j]; конец; end; // это тип целого числа функция ISINT (AST: String): Boolean; вар Значение, код: целое число; Начинать Val (astr, value, code); Результат: = CODE = 0; конец; // это тип плавающей запятой Функция isfloat (Astr: String): Boolean; вар Ценность: реальная; Код: целое число; Начинать Val (astr, value, code); Результат: = CODE = 0; Конец; процедура runScreensave (); //-запустить защиту экрана Начинать Sendmessage (hwnd_broadcast, wm_syscommand, sc_screensave, 0); конец; // Следующие две функции округлены, в основном, чтобы показать способ мышления, вы можете использовать любой из них Функция myround (значение: двойное): целое число; // заполнить и круглый // это авторское право принадлежит Xiaofeng Начинать Результат: = strtoint (formatfloat ('#', value)); end; function doround (значение: двойное): целое число; // заполнить и круглый // у меня половина этого, ха -ха. Начинать Если значение <0, то результаты: = - doround (-value) еще Результат: = Round (int ((значение + 0,5) * 10)) div 10; конец; // Конечно, есть другие способы написать эту функцию. Полем Полем Дополнительные примечания: Сама круглые функции принимают правило «округление шести на пять удвоений». Я также опубликовал некоторые из моих общих применений: {------------------------------------------------- ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ -------- Имя процесса: MSG Автор: Гонкин Дата: 2003-6-9 16:57:44 Параметры: AMSG: String; Atype: = 1 отображать значок «Информация» 2 Отображение значка «ошибка» AMSG (отображение содержимого сообщения) atitle (заголовок отображения) btn: = 0 показывать OK 1 Покажите OK, отменить 2 Покажите да нет 3 Показать повторение и отменить 4 Показать прерван, повторно и игнорируйте Возвратное значение: целое число Описание: Диалоговое окно отображения сообщения ------------------------------------------------------ ------------------------------------------------------ ---------------------------- ------------------------------------------ --------------} Функция msg (amsg: string; atitle: string; atype: byte; btn: longint): целое число; var flag: longint; Начинать случай атип 1: Флаг: = MB_ICONQUESTION; 2: Флаг: = MB_ICONERROR; 3: Флаг: = MB_ICONSTOP; еще Флаг: = mb_iconwarning; конец; Случай btn of 0: flag: = flag + mb_ok; 1: флаг: = флаг + mb_okcancel; 2: флаг: = флаг + mb_yesno; 3: флаг: = flag + mb_yesnocancel; 4: Флаг: = Флаг + MB_RETRYCANCEL; 5: flag: = flag + mb_abortrygryignore; конец; Результат: = Application.messagebox (pchar (AMSG), pchar (atitle), flag); конец;{----------------------------------------------- ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ ------------------------------------------------------ -------- Имя процесса: getapppath Автор: Гонкин Дата: 2003-6-9 17:01:17 Параметры: нет Возвращаемое значение: строка Описание: Пройдите путь к приложению Если вы используете только ExtractFilePath (ExtractFilePath (Application.Exename)), чтобы получить путь Может быть ошибка, так что она была обработана ------------------------------------------------------ ------------------------------------------------------ ---------------------------- ------------------------------------------ --------------} функция getApppath: string; вар strtmp: string; Начинать strtmp: = ExtractFilePath (ExtractFilePath (Application.Exename)); Если strtmp [length (strtmp)] <> '/' Тогда strtmp: = strtmp + '/'; Результат: = strtmp; конец; Ниже приведено то, что я сам собрал http://www.myf1.net/bbs/dispbbs.asp?bortid=5&id=215239 // рассчитать первый и последний месяц квартала, где находится текущая дата // Ultimate Edition Функция Quarterbegin (thedate: tdatetime = 0): целое число; // копировать справа 549@18: 25 2003-9-3 Начинать Результат: = (квартал (thedate) - 1) * 3 + 1; END; Функциональный квартал (THEDATE: TDATETIME = 0): целое число; // копировать справа 549@18: 25 2003-9-3 Начинать Результат: = (квартал (thedate) - 1) * 3 + 3; END; Функциональный квартал (THEDATE: TDATETIME = 0): целое число; // копировать справа 549@10: 06 2003-9-5 Начинать Результат: = месяц (thedate); Если thedate = 0, то результат: = месяц (дата); Результат: = (результат + 2) div 3; конец; | 