- 浏览: 1612649 次
- 性别:
- 来自: 厦门
文章分类
- 全部博客 (603)
- T_java (145)
- T_script&ASP (51)
- T_C/C++ (25)
- T_PowerBuilder (11)
- T_Database (53)
- T_odoo (7)
- T_应用服务器 (50)
- T_专_条形码 (6)
- T_专_负载均衡器 (4)
- T_操作系统 (94)
- T_信息安全 (41)
- T_专_搜索引擎 (14)
- T_L_PHP (58)
- T_L_Delphi (18)
- T_L_.NET、C#、VisualStudio (25)
- T_L_Objective-C (6)
- T_移动开发 (53)
- T_网络 (109)
- T_大数据 (2)
- T_嵌入式 (2)
- T_小众技术 (24)
- T_未分类 (58)
- L_旅游印记 (1)
- L_生活随笔 (48)
- L_中国文化 (18)
- L_户外与生存 (0)
最新评论
-
csbean4004:
不知道哪传来得恶习,发帖子不好好发,故意弄错一些东西,很讨厌
让HTML5支持后置摄像头 -
withthewind:
终于找到一个可以用的了。。。
如何用VBA取得Word文档中的标题前面的序号 -
busbby:
兄弟,无法下载,说文件不完整
一个好用的Outlook ost格式文件转pst文件的工具 -
yijavakevin:
密码啊~解压密码多少?
一个二维条形码组件 -
vipbooks:
你给的那个链接根本无法下载,跳到官网看了下最新版12M,但点下 ...
十步以内完成精细web打印
unit U_SystemParams; { ========================================== delphi写的一个读写xml格式配置文件的帮助类 ========================================== 写元素和属性的范例代码: procedure TForm1.Button1Click(Sender: TObject); var sysParams : U_SystemParams; begin sysParams := U_SystemParams.Create(); try sysParams.setElementText('/config/title', '配置文件'); sysParams.setElementTextAttribute('/config/user', 'name', '张飞'); sysParams.setElementIntegerAttribute('/config/user', 'age', 22); sysParams.setElementBooleanAttribute('/config/user', 'isadmin', true); sysParams.setElemenetDatetimeAttribute('/config/user', 'date', Now); mmLogs.Lines.Add(sysParams.getXmlDocument.xml); sysParams.saveToFile('systemParams.xml'); finally freeandnil(sysParams); end;//finally end; 输出结果如下: <config> <title>配置文件</title> <user name="张飞" age="22" isadmin="True" date="2008-8-19"/> </config> 读元素和属性的范例代码: procedure TForm1.Button2Click(Sender: TObject); var sysParams : U_SystemParams; sTemp : String; bTemp : boolean; iTemp : Integer; dTemp : TDatetime; begin sysParams := U_SystemParams.Create('systemParams.xml'); try sTemp := sysParams.getElementTextAttribute('/config/user', 'name'); bTemp := sysParams.getElementBooleanAttribute('/config/user', 'isadmin'); iTemp := sysParams.getElementIntAttribute('/config/user', 'age'); dTemp := sysParams.getElemenetDateTimeAttribute('/config/user', 'date'); mmLogs.lines.Add('title = ' + sysParams.getElementText('/config/title')); mmLogs.Lines.Add('name = ' + ' = ' + sTemp); mmLogs.Lines.Add('isadmin' + ' = ' + BoolToStr(bTemp, true)); mmLogs.Lines.Add('age' + ' = ' + IntToStr(iTemp)); mmLogs.Lines.Add('date' + ' = ' + DateTimeToStr(dTemp)); finally freeandnil(sysParams); end;//finally end; 输出结果如下: title = 配置文件 name = = 张飞 isadmin = True age = 22 date = 2008-8-19 } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, MSXML2_TLB, uUtility; type TSystemParams = class private FXmlDocument: IXMLDOMDocument; FXmlFileName : String; protected public constructor Create(const xmlfilename : String); overload;virtual; constructor Create; overload;virtual; destructor Destroy; override; procedure loadFromFile(const xmlfilename : String); virtual; procedure saveToFile; overload;virtual; procedure saveToFile(const xmlFileName : String); overload;virtual; function getXmlDocument: IXMLDOMDocument; virtual; function getElementText(const nodePath: string; const defaultValue : String = ''): string; virtual; procedure setElementText(const nodepath, value: string); virtual; function getElementTextAttribute(const nodePath, attrName : string; const defaultValue : String = '') : string; procedure setElementTextAttribute(const nodePath, attrName, attrValue : string); function getElementBooleanAttribute(const nodePath, attrName : String; const default : boolean = false) : boolean; procedure setElementBooleanAttribute(const nodePath, attrName : String; const value : boolean); function getElementIntAttribute(const nodePath, attrName : String; const default : Integer = -1) : integer; procedure setElementIntegerAttribute(const nodePath, attrName : String; const value : integer); function getElemenetDateTimeAttribute(const nodePath, attrName : String; const default : TDateTime = 0) : TDateTime; procedure setElemenetDatetimeAttribute(const nodePath, attrName : String; const value : TDateTime); procedure setElementBoolValue(const nodeName : String; value : boolean); function getElementBoolValue(const nodeName : String; const defaultValue : boolean =false) : boolean; procedure setElementIntValue(const nodeName : String; value : Integer); function getElementIntValue(const nodeName : String; const defaultValue : integer = -1) : Integer; procedure setElementDatetimeValue(const nodeName : String; value : TDateTime); function getDatetimeValue(const nodeName : String; const defaultValue : TDateTime = 0) : TDateTime; function loadXmlElement(const nodePath : string) : IXMLDOMElement; virtual; end; implementation constructor TSystemParams.Create(const xmlfilename : String); begin FXmlDocument := CoDOMDocument60.Create(); loadFromFile(xmlfilename); end; constructor TSystemParams.Create; begin FXmlDocument := CoDOMDocument60.Create(); end; destructor TSystemParams.Destroy; begin FXmlDocument := nil; inherited; end; function TSystemParams.getElementBooleanAttribute(const nodePath, attrName: String; const default: boolean = false): boolean; begin result := StrToBoolDef(getElementTextAttribute(nodePath, attrName, BoolToStr(default, true)), default); end; function TSystemParams.getElementBoolValue(const nodeName: String; const defaultValue : boolean =false): boolean; begin Result := StrToBool(getElementText(nodeName, BoolToStr(defaultValue, defaultValue))); end; function TSystemParams.getDatetimeValue(const nodeName: String; const defaultValue : TDateTime = 0): TDateTime; begin Result := StrToDateTime(getElementText(nodeName, DateTimeToStr(defaultValue))); end; function TSystemParams.getElementIntAttribute(const nodePath, attrName: String; const default: Integer = -1): integer; begin Result := strToInt(getElementTextAttribute(nodePath, attrName, IntToStr(default))); end; function TSystemParams.getElementIntValue(const nodeName: String; const defaultValue : integer = -1): Integer; begin Result := StrToInt(getElementText(nodeName, IntToStr(defaultValue))); end; function TSystemParams.getElemenetDateTimeAttribute(const nodePath, attrName: String; const default: TDateTime = 0): TDateTime; begin Result := StrToDateTime(getElementTextAttribute(nodePath, attrName, datetoStr(default))); end; function TSystemParams.getElementTextAttribute(const nodePath, attrName: string; const defaultValue : String = ''): string; var element : IXMLDOMElement; node : IXMLDOMNode; begin element := loadXmlElement(nodePath); node := element.attributes.getNamedItem(attrName); if node <> nil then Result := node.text else Result := defaultValue; end; function TSystemParams.getElementText(const nodePath: string; const defaultValue : String = ''): string; var node: IXMLDOMNode; i: Integer; begin result := ''; node := FXmlDocument.selectSingleNode(nodePath); if assigned(node) then Result := node.text else Result := defaultValue; end; function TSystemParams.getXmlDocument: IXMLDOMDocument; begin result := FXmlDocument; end; function TSystemParams.loadXmlElement(const nodePath: string): IXMLDOMElement; var slist : TStrings; i : Integer; parent, temp : IXMLDOMElement; xName : string; begin result := nil; slist := TStringList.Create; try StrToKenToStrings(nodePath, '/', slist); if (sList[0] ='/') or (sList[0] = '') then begin slist.Delete(0); end; parent := FXmlDocument.documentElement; if (parent <> nil) and (parent.nodeName <> slist[0]) then raise Exception.CreateFmt('已经有一个根元素%s了,不能再加一个不同的根%s', [parent.nodeName, slist[0]]); for i := 0 to slist.Count - 1 do begin xName := xName + '/' + slist[i]; result := IXMLDOMElement(FXmlDocument.selectSingleNode(xName)); if result = nil then begin result := FXmlDocument.createElement(slist[i]); if i = 0 then begin parent := Result; FXmlDocument.appendChild(parent); end else begin parent.appendChild(result); end; parent := result; end; end;//i finally freeandnil(sList); end;//finally end; procedure TSystemParams.loadFromFile(const xmlfilename : String); var AHasDocument: Boolean; begin FXmlFileName := xmlfilename; if FileExists(FXmlFileName) then FXmlDocument.load(FXmlFileName) else raise Exception.Create(FXmlFileName + ' 文件没有找到,加载xml失败'); FXmlDocument.createProcessingInstruction('xml','version="1.0" encoding="UTF-8"'); end; procedure TSystemParams.saveToFile(); begin FXmlDocument.save(FXmlFileName); end; procedure TSystemParams.saveToFile(const xmlFileName: String); begin FXmlDocument.save(xmlFileName); end; procedure TSystemParams.setElementBooleanAttribute(const nodePath, attrName: String; const value: boolean); begin setElementTextAttribute(nodePath, attrName, boolToStr(value, true)); end; procedure TSystemParams.setElementBoolValue(const nodeName: String; value: boolean); begin setElementText(nodeName, BoolToStr(value, true)); end; procedure TSystemParams.setElementDatetimeValue(const nodeName: String; value: TDateTime); begin setElementText(nodeName, DateTimeToStr(value)); end; procedure TSystemParams.setElementIntegerAttribute(const nodePath, attrName: String; const value: integer); begin setElementTextAttribute(nodePath, attrName, IntToStr(value)); end; procedure TSystemParams.setElementIntValue(const nodeName: String; value: Integer); begin setElementText(nodeName, IntToStr(value)); end; procedure TSystemParams.setElemenetDatetimeAttribute(const nodePath, attrName: String; const value: TDateTime); begin setElementTextAttribute(nodePath, attrName, DateToStr(value)); end; procedure TSystemParams.setElementTextAttribute(const nodePath, attrName, attrValue: string); var node : IXMLDOMElement; attr : IXMLDOMAttribute; begin node := IXMLDOMElement(FXmlDocument.selectSingleNode(nodePath)); if node = nil then node := loadXmlElement(nodePath); attr := FXmlDocument.createAttribute(attrName); attr.text := attrValue; node.attributes.setNamedItem(attr); end; procedure TSystemParams.setElementText(const nodepath, value: string); var node, temp: IXMLDOMNode; begin temp := FXmlDocument.selectSingleNode(nodepath); if assigned(temp) then temp.text := value else begin temp := loadXmlElement(nodepath); temp.text := value; end; end; end.
其中用到的uUtility单元代码如下:
unit uUtility; interface uses Forms, Windows, SysUtils, Classes, shellapi, variants, activex, MaskUtils, Controls; resourcestring rsCanGetComputerName = '无法取得计算机名'; rsNotIntegerValue = '"%s" 不是整型数字'; rsQuestion = '提示'; {----------------------------------------------------------------------------- Procedure: StrToken 从源字符串中根据分隔符依次截取并返回分隔符之前的字符串,直到源字符串为空 Author: jim(xProcs.pas) Date: 2002-7-8 Arguments: var S: string; Seperator: Char;分隔符 Result: string 返回分隔符之前的字符 -----------------------------------------------------------------------------} function StrToken(var S: string; Seperator: Char): string; {----------------------------------------------------------------------------- Procedure: strTokenCount 计算字符串中包含指定字符的个数 Author: jim(xProcs.pas) Date: 2002-8-30 Arguments: S: String; 源字符串 Seperator: Char; 分隔符 List: TStrings 串表 Result: None -----------------------------------------------------------------------------} function strTokenCount(S: string; Seperator: Char): Integer; {----------------------------------------------------------------------------- Procedure: strTokenToStrings 把用分隔符隔开的串放入一个串表 Author: jim(xProcs.pas) Date: 2002-7-8 Arguments: S: String; 源字符串 Seperator: Char; 分隔符 List: TStrings 串表 Result: None -----------------------------------------------------------------------------} procedure StrToKenToStrings(S: string; Seperator: Char; List: TStrings); {----------------------------------------------------------------------------- Procedure: StrTokenStr 从源字符串中根据分隔字符串依次截取并返回分隔字符串之前的字符串,直到源字符串为空 Author: jim Date: 2002-7-11 Arguments: Str: string; 需要截取的字符串 subStr:string; 分隔字符串 Result: Boolean -----------------------------------------------------------------------------} function StrTokenStr(var Str: string; const subStr: string): string; {----------------------------------------------------------------------------- Procedure: IsNumeric 判断是否是数字 Author: jim Date: 2002-7-11 Arguments: ch: char 字符 Result: Boolean -----------------------------------------------------------------------------} function IsNumeric(ch: char): boolean; {----------------------------------------------------------------------------- Procedure: IsInteger 检测字符串是否是整数 Author: jim Date: 2002-7-11 Arguments: s: string; 待检测字符串 APositiveOnly:boolean; 只检测正数(默认是 True) Result: Boolean -----------------------------------------------------------------------------} function IsInteger(s: string; APositiveOnly: Boolean = True): Boolean; {----------------------------------------------------------------------------- Procedure: IsFloat 检测字符串是否是浮点数 Author: jim Date: 2002-7-11 Arguments: s: string; 待检测字符串 APositiveOnly:boolean; 只检测正数( 默认是 True) Result: Boolean -----------------------------------------------------------------------------} function IsFloat(s: string; APositiveOnly: Boolean = True): Boolean; {----------------------------------------------------------------------------- Procedure: isDateTime 检测字符串是否是日期格式 Author: jim Date: 2002-8-30 Arguments: AValue: string 待检测字符串 Result: Boolean -----------------------------------------------------------------------------} function IsDateTime(const AValue: string): Boolean; {----------------------------------------------------------------------------- Procedure: delay 延时函数,等同于sleep Author: jim(xProcs.pas) Date: 2002-7-11 Arguments: ms: Longint 毫秒 Result: None -----------------------------------------------------------------------------} procedure delay(ms: Cardinal); {----------------------------------------------------------------------------- Procedure: sysDelay 延时函数 Author: jim(xProcs.pas) Date: 2002-7-11 Arguments: aMs: Longint 毫秒 Result: None -----------------------------------------------------------------------------} procedure sysDelay(aMs: Cardinal); {----------------------------------------------------------------------------- Procedure: ShowInformationMessage 显示一个提示信息话胡框 Author: jim Date: 2002-10-24 Arguments: AContent : string; 提示信息 ATitle : string = 'Information';对话框标题 Result: None -----------------------------------------------------------------------------} procedure ShowInformationMessage(const AContent: string; const ATitle: string = '提示'); {----------------------------------------------------------------------------- Procedure: ShowWarningMessage 显示一个警告信息对话框 Author: jim Date: 2002-7-16 Arguments: AContent : string; 警告信息 ATitle : string = 'Warning';对话框标题 Result: None -----------------------------------------------------------------------------} procedure ShowWarningMessage(const AContent: string; const ATitle: string = '警告'); {----------------------------------------------------------------------------- Procedure: ShowErrorMessage 显示一个错误信息对话框 Author: jim Date: 2002-7-19 Arguments: const AContent : string;错误信息 const ATitle: string = 'Error';对话框标题 Result: None -----------------------------------------------------------------------------} procedure ShowErrorMessage(const AContent: string; const ATitle: string = '错误'); {----------------------------------------------------------------------------- Procedure: ShowInformationMessageFmt 显示一个提示信息对话框 Author: jim Date: 2002-7-19 Arguments: const AContent : string;错误信息 const ATitle: string = 'Error';对话框标题 Result: None -----------------------------------------------------------------------------} procedure ShowInformationMessageFmt(const AContent: string; Args: array of const; const ATitle: string = '提示'); {----------------------------------------------------------------------------- Procedure: ShowErrorMessage 显示一个错误信息对话框 Author: jim Date: 2002-7-19 Arguments: const AContent : string;错误信息 const ATitle: string = 'Error';对话框标题 Result: None -----------------------------------------------------------------------------} procedure ShowWarningMessageFmt(const AContent: string; Args: array of const; const ATitle: string = '警告'); procedure ShowErrorMessageFmt(const AContent: string; Args: array of const; const ATitle: string = '错误'); {----------------------------------------------------------------------------- Procedure: Ask 询问是或者否的对话框。返回boolean值 Author: jim Date: 16-八月-2002 Arguments: const AContent : string;提示信息 const Atite : string = 'Question'标题 Result: Boolean -----------------------------------------------------------------------------} function Ask(const AContent: string; DefaultButton: Byte = 1): Boolean; {----------------------------------------------------------------------------- Procedure: 取得计算机名字 Author: jim Date: 2004-4-16 Arguments: None Result: string -----------------------------------------------------------------------------} function GetPCName: string; {----------------------------------------------------------------------------- Procedure: BoolToInt 把布尔值转换成整型值,true -> 1; false -> 0 Author: jim Date: 2002-8-21 Arguments: const Value : Boolean Result: Integer -----------------------------------------------------------------------------} function BoolToInt(const Value: Boolean): Integer; {----------------------------------------------------------------------------- Procedure: IntToBool 把整型值转换成布尔值,1 -> true; 0 -> false Author: jim Date: 2002-8-21 Arguments: const Value : Integer Result: Boolean -----------------------------------------------------------------------------} function IntToBool(const Value: Integer): Boolean; {----------------------------------------------------------------------------- Procedure: StringToInt Author: jim Date: 2002-8-21 Arguments: const Value : stirng Result: Boolean -----------------------------------------------------------------------------} function StringToInt(const Value: string; DefaultValue: Integer = 0): Integer; {----------------------------------------------------------------------------- Procedure: IntToLenStr 整型转换成定长的字符串 Author: jim Date: 2002-8-21 Arguments: i : integer 整型值 len :integer 返回长度 Result: Boolean -----------------------------------------------------------------------------} function IntToLenStr(const i, Len: integer): string; overload; function IntToLenStr(const i, Len: integer; PadChar: char): string; overload; {----------------------------------------------------------------------------- Procedure: IsIncludeChars 指定字符串S中的每一个字符是否存在于CharList字符串中 Author: jim Date: 2002-8-21 Arguments: const S 待判断字符串 CharList 字符列表串 Result: Boolean -----------------------------------------------------------------------------} function IsIncludeChars(const S, CharList: string): Boolean; {----------------------------------------------------------------------------- Procedure: AddToVarArray 把指定的开放数组加入到变体数组的最后,使变体数组的Count+1 Author: jim Date: 2004-4-16 Arguments: var V: Variant;传出的变体数组 Args: array of const 传入的开放数组 Result: None -----------------------------------------------------------------------------} procedure AddToVarArray(var V: Variant; Args: array of const); {----------------------------------------------------------------------------- Procedure: ReplaceChar 在字符串中替换字符 Author: jim Date: 2002-9-5 Arguments: str :需要替换的字串 SourceChar:需要替换的字符 DestChar:替换的字符 Result: stirng 返回替换后的字串 -----------------------------------------------------------------------------} function ReplaceChar(const str: string; SourceChar, DestChar: Char): string; {----------------------------------------------------------------------------- Procedure: addSpaces 在字符串前面或者后面添加指定个数的空格 Author: jim Date: 2002-9-5 Arguments: str :需要添加空格的字串 Len:添加空格的数量 addAfter:位置(true表示在尾部追加,false表示在首部插入); Result: stirng 返回处理后的字串 -----------------------------------------------------------------------------} function addSpaces(Str: string; Len: integer; const addAfter: boolean = true): string; {----------------------------------------------------------------------------- Procedure: 判断键值是否是可显示字符 Author: jim Date: 2003-08-06 Arguments: Ch : Word Result: Boolean -----------------------------------------------------------------------------} function IsPrintabledChar(Ch: Word): Boolean; {----------------------------------------------------------------------------- Procedure: 得到一个全局唯一的数字,一般用于给控件起名用 Author: jim Date: 2003-09-24 Arguments: None Result: Integer -----------------------------------------------------------------------------} function GetUniqueNumber: Integer; {----------------------------------------------------------------------------- Procedure: GetAppBarScale Author: jim Date: 2003-10-27 Arguments: None Result: TPoint -----------------------------------------------------------------------------} function GetAppBarScale: TPoint; {----------------------------------------------------------------------------- Procedure: URLink 打开指定的url Author: jim Date: 2003-10-27 Arguments: URL: string 网址 Result: none -----------------------------------------------------------------------------} procedure URLink(URL: string); {----------------------------------------------------------------------------- Procedure: FirstDelimiter 从左侧开始的第一个 Delimiters中任意字符的位置和LastDelimiter作用相反 Author: jim Date: 2003-12-24 Arguments: Delimiters :待选字符 S: 待查字符 Result: Integer -----------------------------------------------------------------------------} function FirstDelimiter(const Delimiters, S: string): Integer; {----------------------------------------------------------------------------- Procedure: extractRealFileName 解析得到真正的文件名,返回 文件名.扩展名 Author: jim Date: 2003-12-24 Arguments: fileName: string 文件名 Result: string 文件名.扩展名 -----------------------------------------------------------------------------} function extractRealFileName(const fileName: string): string; {----------------------------------------------------------------------------- Procedure: getModuleVersion 得到模块的版本号,模块可以是执行文件也可以是dll和bpl Author: jim Date: 2003-12-24 Arguments: appInstance: Cardinal 模块的实例句柄 Result: string 对应模块的版本号 -----------------------------------------------------------------------------} function getModuleVersion(appInstance: Cardinal): string; {----------------------------------------------------------------------------- Procedure: int2Bin 整型转成二进制字符 Author: jim Date: 2003-12-24 Arguments: Value: Cardinal 正整数 Result: string 对应二进制数字 -----------------------------------------------------------------------------} function int2Bin(Value: cardinal): string; {----------------------------------------------------------------------------- Procedure: int2Bin 整型转成二进制字符 Author: jim Date: 2003-12-24 Arguments: Value: Cardinal 正整数 Result: string 对应二进制数字 -----------------------------------------------------------------------------} function AddStr(sourcestr: string; Len: Integer; AddStr: Char; Eof: Boolean = False): string; {----------------------------------------------------------------------------- Procedure: generateGUID 计算得到一个GUID Author: jim Date: 2003-12-24 Arguments: none Result: string 全球唯一GUID -----------------------------------------------------------------------------} function generateGUID: TGUID; (*----------------------------------------------------------------------------- Procedure: generateGUIDString 生成GUID字符串 Author: jim Date: 2008-9-16 Arguments: Result: GUID字符串,类似:{850E7BAC-16BA-40C4-9DD1-E3BFE8FEDC09} -----------------------------------------------------------------------------*) function generateGUIDString: string; {----------------------------------------------------------------------------- Procedure: generateGUIDKey 生成GUID主键,32位长度,全字母和数字 Author: jim Date: 2008-9-16 Arguments: Result: GUID主键 -----------------------------------------------------------------------------} function generateGUIDKey: string; {----------------------------------------------------------------------------- Procedure: cloneString 把指定的字符串复制若干次,并返回最终复制后的结果, 此函数具有缓存机制,可以自动找回上次克隆之后的字符串,提高效率 Author: jim Date: 2008-9-16 Arguments: str: 需要克隆的字符串 cloneCount:克隆的次数 Result: 克隆后的字符串 -----------------------------------------------------------------------------} function cloneString(const str: string; const cloneCount: Integer): string; {----------------------------------------------------------------------------- Procedure: var2Int 变体转换成整型 Author: jim Date: 2008-9-16 Arguments: v: 需要转换的变体 def:转换失败的默认值 Result: 克隆后的字符串 -----------------------------------------------------------------------------} function var2Int(const v: variant; const def: integer = 0): Integer; {----------------------------------------------------------------------------- Procedure: RemoveEditFormat 在指定格式的字串中提取无格式字串。 如:格式是">L##!-##!-#;0;" 格式字串"A01-01-1"得到的无格式字串是 A01011。 要注意的是:abcdefgh 得到的是abcefh Author: jim(Mask.pas) Date: 2002-9-5 Arguments: EditMask :字串的格式,参考 delphi help "TEditMask type" Value :格式化字串 MaskBlank :空白符 Result: stirng 返回无格式字串 -----------------------------------------------------------------------------} function RemoveEditFormat(EditMask: TEditMask; const Value: string; MaskBlank: Char): string; {----------------------------------------------------------------------------- Procedure: nvl 根据对象是否为nil,不为空就返回第二个参数,为空就返回第三个参数 Author: jim Date: 2008-9-16 Arguments: prt: 需要检查的指针(可以是对象也可以是接口); val1, val2:需要根据条件返回的值 Result: 克隆后的字符串 -----------------------------------------------------------------------------} function nvl(const obj: TObject; const val1, val2: string): string; overload; function nvl(const obj: TObject; const val1, val2: Integer): Integer; overload; function nvl(const obj: TObject; const val1, val2: double): double; overload; function nvl(const obj: TObject; const val1, val2: TObject): TObject; overload; function nvl(const obj: TObject; const val1, val2: IInterface): IInterface; overload; function nvl(const obj: TObject; const val1, val2: Char): Char; overload; function nvl(const intf: IInterface; const val1, val2: string): string; overload; function nvl(const intf: IInterface; const val1, val2: Integer): Integer; overload; function nvl(const intf: IInterface; const val1, val2: double): double; overload; function nvl(const intf: IInterface; const val1, val2: TDatetime): TDateTime; overload; function nvl(const intf: IInterface; const val1, val2: TObject): TObject; overload; function nvl(const intf: IInterface; const val1, val2: IInterface): IInterface; overload; function nvl(const intf: IInterface; const val1, val2: Char): Char; overload; {----------------------------------------------------------------------------- Procedure: ifReturn 根据对象是否为nil,不为空就返回第二个参数,为空就返回第三个参数 Author: jim Date: 2008-9-16 Arguments: prt: 需要检查的指针(可以是对象也可以是接口); val1, val2:需要根据条件返回的值 Result: 返回的字符串 -----------------------------------------------------------------------------} function ifReturn(const check: boolean; const val1, val2: string): string; overload; function ifReturn(const check: boolean; const val1, val2: Integer): Integer; overload; function ifReturn(const check: boolean; const val1, val2: double): double; overload; function ifReturn(const check: boolean; const val1, val2: TObject): TObject; overload; function ifReturn(const check: boolean; const val1, val2: IInterface): IInterface; overload; function ifReturn(const check: boolean; const val1, val2: Char): Char; overload; {----------------------------------------------------------------------------- Procedure: filePath2UrlPath 文件路径转为url路径,例如 c:\aa\bb.ppt 转为 c:/aa/bb.ppt Author: jim Date: 2008-9-16 Arguments: prt: 需要检查的指针(可以是对象也可以是接口); val1, val2:需要根据条件返回的值 Result: 返回的字符串 -----------------------------------------------------------------------------} function filePath2UrlPath(const filePath: string): string; {----------------------------------------------------------------------------- Procedure: strRight 从右侧开始,复制指定数量的字符 Author: jim Date: 2009-1-19 Arguments: s:原字符串 count:数量 Result: 返回的字符串 -----------------------------------------------------------------------------} function strRight(const s: string; count: Integer): string; {----------------------------------------------------------------------------- Procedure: strHasSuffix 判断字符串(S)是否以指定字符串(subStr)结尾 Author: jim Date: 2009-1-19 Arguments: s:原字符串 subStr:包含的字符串 Result: boolean -----------------------------------------------------------------------------} function strHasSuffix(const S, subStr: string): boolean; {----------------------------------------------------------------------------- Procedure: parserFtpUrl 解析ftp url,从中得到主机名,用户名,密码,url内容 例如解析ftp://ftpguest:123@localhost:8022/publicfiles/downloadfields/demo.inf后,得到如下信息 AHost = localhost AUser = ftpguest APassword = 123 AURL = /publicfiles/downloadfields/demo.inf APort = 8022 Author: jim Date: 2009-1-19 Arguments: AFtpUrl: string; URL地址 AHost 主机名 AUser 用户名 APassword 密码 AUrl: string URL out APort: Integer 端口号 ADefaultPort: Integer = 21 Result: none -----------------------------------------------------------------------------} procedure parserFtpUrl(const AFtpUrl: string; out AHost, AUser, APassword, AUrl: string; out APort: Integer; ADefaultPort: Integer = 21); {----------------------------------------------------------------------------- Procedure: setSystemTime 设置系统时间为指定时间 Author: jim Date: 2009-3-18 Arguments: const aTime : TTime 时间 Result: none -----------------------------------------------------------------------------} procedure setSystemTime(const aTime: TTime); {----------------------------------------------------------------------------- Procedure: setSystemDate 设置系统日期为指定日期 Author: jim Date: 2009-3-18 Arguments: const aDate : TDate 日期 Result: none -----------------------------------------------------------------------------} procedure setSystemDate(const aDate: TDate); {----------------------------------------------------------------------------- Procedure: setSystemDateTime 设置系统日期时间为指定日期时间 Author: jim Date: 2009-3-18 Arguments: const aDateTime : TDateTime 日期时间 Result: none -----------------------------------------------------------------------------} procedure setSystemDateTime(const aDateTime: TDateTime); {----------------------------------------------------------------------------- Procedure: readFromFile 读取文本文件内容,返回字符串 Author: jim Date: 2009-3-18 Arguments: const fileName : 文本文件全路径名 Result: String 返回字符串 -----------------------------------------------------------------------------} function readFromFile(const fileName: string): string; {----------------------------------------------------------------------------- Procedure: listFiles 显示出目录中的所有文件(不递归子目录); Author: jim Date: 2009-05-11 Arguments: const path 需要列的目录名 fileMask : String 文件蒙版,例如*.exe;a*.exe等 Result: TStrings -----------------------------------------------------------------------------} function listFiles(const path, fileMask: string): TStrings; {----------------------------------------------------------------------------- Procedure: listDirs 显示出目录中的所有目录(不递归子目录); Author: jim Date: 2009-05-11 Arguments: const path : String Result: TStrings -----------------------------------------------------------------------------} function listDirs(const path: string): TStrings; {----------------------------------------------------------------------------- Procedure: deleteDirAndFiles 删除目录以及目录里面的文件 Author: jim Date: 2009-05-11 Arguments: const path: string Result: boolean -----------------------------------------------------------------------------} function deleteDirAndFiles(const path: string): boolean; implementation type _TCloneString = record count: Integer; cloneStr: string; result: string; end; var _UniqueNumber: Integer; _cachedCloneString: _TCloneString; procedure URLink(URL: string); begin ShellExecute(0, nil, PChar(URL), nil, nil, SW_NORMAL); end; function addSpaces(Str: string; Len: integer; const addAfter: boolean = true): string; var sublen: integer; TempStr: string; begin TempStr := str; if len > Length(TempStr) then begin sublen := Len - Length(TempStr); if addAfter then begin TempStr := TempStr + StringofChar(' ', subLen); end else begin TempStr := StringofChar(' ', subLen) + TempStr; end; end else begin TempStr := Copy(TempStr, 1, len); end; Result := TempStr; end; function StrToken(var S: string; Seperator: Char): string; var I: Word; begin I := Pos(Seperator, S); if I <> 0 then begin Result := System.Copy(S, 1, I - 1); System.Delete(S, 1, I); end else begin Result := S; S := ''; end; end; procedure StrToKenToStrings(S: string; Seperator: Char; List: TStrings); var Token: string; Flag: Boolean; begin List.Clear; Flag := System.Copy(S, length(S), 1) = Seperator; while (S <> '') do begin Token := strToken(S, Seperator); List.Add(Token); end; if Flag then List.Add(''); end; function StrTokenStr(var Str: string; const subStr: string): string; var iPos: Integer; begin iPos := Pos(SubStr, Str); SetLength(Result, iPos - 1); if iPos <> 0 then begin Move(Str[1], Result[1], iPos - 1); system.Delete(Str, 1, Length(subStr) + iPos - 1); end else begin Result := Str; Str := ''; end; end; procedure delay(ms: Cardinal); var TickCount: Cardinal; begin TickCount := GetTickCount; while GetTickCount - TickCount < ms do //Application.ProcessMessages; Sleep(ms); end; procedure sysDelay(aMs: Cardinal); begin Sleep(aMs); end; function IsNumeric(ch: char): boolean; begin Result := ch in ['0'..'9']; end; function IsInteger(s: string; APositiveOnly: Boolean = True): Boolean; var i: Integer; c: Char; begin Result := False; if Length(s) = 0 then Exit; if APositiveOnly then begin for i := 1 to Length(s) do begin c := s[i]; if not IsNumeric(c) then Exit; end; end else begin for i := 1 to Length(s) do if not IsNumeric(s[i]) and ((i <> 1) or (s[i] <> '-')) then Exit; end; Result := True; end; function IsFloat(s: string; APositiveOnly: Boolean = True): Boolean; const sDiagits = '.0123456789'; var i: Integer; begin Result := False; if Length(s) = 0 then Exit; if APositiveOnly then begin for i := 1 to Length(s) do begin if Pos(s[i], sDiagits) <= 0 then Exit; end; end else begin for i := 1 to Length(s) do begin if Pos(s[i], sDiagits) <= 0 then if not ((i = 1) and (s[1] = '-')) then Exit; end; end; if (not APositiveOnly) and (s[1] = '-') then Result := IsNumeric(s[2]) else Result := IsNumeric(s[1]); end; procedure ShowInformationMessage(const AContent: string; const ATitle: string = '提示'); begin Application.MessageBox(PChar(AContent), PChar(ATitle) , MB_OK + MB_ICONASTERISK + MB_DEFBUTTON1 + MB_APPLMODAL); end; procedure ShowWarningMessage(const AContent: string; const ATitle: string = '警告'); begin Application.MessageBox(PChar(AContent), PChar(ATitle) , MB_OK + MB_ICONEXCLAMATION + MB_DEFBUTTON1 + MB_APPLMODAL); end; procedure ShowErrorMessage(const AContent: string; const ATitle: string = '错误'); begin Application.MessageBox(PChar(AContent), pchar(ATitle), MB_OK + MB_ICONHAND + MB_DEFBUTTON1 + MB_APPLMODAL); end; procedure ShowInformationMessageFmt(const AContent: string; Args: array of const; const ATitle: string = '提示'); begin ShowInformationMessage(Format(AContent, args), ATitle); end; procedure ShowWarningMessageFmt(const AContent: string; Args: array of const; const ATitle: string = '警告'); begin ShowWarningMessage(Format(AContent, args), ATitle); end; procedure ShowErrorMessageFmt(const AContent: string; Args: array of const; const ATitle: string = '错误'); begin ShowErrorMessage(Format(AContent, args), ATitle); end; function Ask(const AContent: string; DefaultButton: Byte = 1): Boolean; var ButtonFlag: Integer; begin case DefaultButton of 1: ButtonFlag := MB_DEFBUTTON1; 2: ButtonFlag := MB_DEFBUTTON2; else ButtonFlag := MB_DEFBUTTON1; end; Result := Application.MessageBox(PChar(AContent), PChar(rsQuestion), MB_YESNO + MB_ICONQUESTION + ButtonFlag + MB_APPLMODAL) = ID_YES; end; function GetPCName: string; var ComputerNameLen: ^DWORD; ComputerNameBuffer: PChar; begin Result := ''; try try GetMem(ComputerNameBuffer, 255); New(ComputerNameLen); ComputerNameLen^ := 255; if GetComputerName(ComputerNameBuffer, ComputerNameLen^) then Result := StrPas(ComputerNameBuffer); finally FreeMem(ComputerNameBuffer); Dispose(ComputerNameLen); end; except end; end; function BoolToInt(const Value: Boolean): Integer; begin Result := Ord(Value); end; { BoolToInt } function IntToBool(const Value: Integer): Boolean; begin Result := Value <> 0; end; { IntToBool } function StringToInt(const Value: string; DefaultValue: Integer = 0): Integer; begin if (Length(Value) = 0) or not IsInteger(Value, False) then Result := DefaultValue else Result := StrToInt(Value); end; function IntToLenStr(const i, Len: integer): string; begin result := IntToLenStr(i, Len, ' '); end; function IntToLenStr(const i, Len: integer; PadChar: char): string; overload; begin Result := IntToStr(i); if Length(Result) <= Len then Result := StringOfChar(PadChar, Len - Length(Result)) + Result; end; function strTokenCount(S: string; Seperator: Char): Integer; var sTemp: string; begin sTemp := S; Result := 0; while sTemp <> '' do begin { 29.10.96 sb } StrToken(sTemp, Seperator); Inc(Result); end; end; function IsIncludeChars(const S, CharList: string): Boolean; var i: Integer; begin Result := False; for i := 1 to Length(S) do begin if Pos(S[i], CharList) <= 0 then Exit; end; //i Result := True; end; function IsDateTime(const AValue: string): Boolean; var sDATETIME_CHAR: string; sDate, sTime, s, sTemp: string; iTemp, iIndex: Integer; begin sDATETIME_CHAR := '1234567890 :' + DateSeparator; Result := False; //如果长度为零则返回False if Trim(AValue) = '' then Exit; ; //如果包含不可识别字符则返回False if not IsIncludeChars(AValue, sDATETIME_CHAR) then Exit; //如果被日期分隔符隔开的字符串不是3个则返回False if strTokenCount(AValue, DateSeparator) <> 3 then Exit; if strTokenCount(AValue, ' ') > 2 then Exit; s := AValue; sDate := StrToken(s, ' '); stime := s; iIndex := 0; //检测日期 while sDate <> '' do begin Inc(iIndex); sTemp := StrToken(sDate, DateSeparator); if not IsInteger(sTemp) then Exit; iTemp := StrToInt(sTemp); if iTemp = 0 then Exit; case iIndex of 2: if iTemp > 12 then Exit; //如果月份大于12则返回False 3: if iTemp > 31 then Exit; //如果日期大于31则返回False end; //case end; //while iIndex := 0; if sTime <> '' then begin s := sTime; //计算时间部分的被时间分隔符隔开的字符串不是3个则返回False if strTokenCount(s, TimeSeparator) <> 3 then Exit; //检测时间 while sTime <> '' do begin Inc(iIndex); sTemp := StrToken(sTime, TimeSeparator); if not IsInteger(sTemp) then Exit; iTemp := StrToInt(sTemp); case iIndex of 1: if (iTemp > 24) or (iTemp < 0) then Exit; //小时部分检测 2, 3: if iTemp > 60 then Exit; //分钟、秒部分检测 end; //case end; //while end; //if Result := True; //返回True end; procedure AddToVarArray(var V: Variant; Args: array of const); var i, Count: Integer; vFields: Variant; begin if not VarIsArray(V) then V := VarArrayCreate([0, 0], varVariant); Count := VarArrayHighBound(V, 1); VarArrayRedim(V, Count + 1); vFields := VarArrayCreate([0, High(Args) - Low(Args)], varVariant); for i := Low(Args) to High(Args) do with Args[i] do case VType of vtInteger: vFields[i] := Args[i].VInteger; vtBoolean: vFields[i] := Args[i].VBoolean; vtChar: vFields[i] := Args[i].VChar; vtExtended: vFields[i] := Args[i].VExtended^; vtString: vFields[i] := Args[i].VString^; vtPChar: vFields[i] := string(Args[i].VPChar); vtPWideChar: vFields[i] := string(Args[i].VPWideChar); vtObject: vFields[i] := Args[i].VObject.ClassName; vtClass: vFields[i] := Args[i].VClass.ClassName; vtAnsiString: vFields[i] := string(Args[i].VAnsiString); vtWideString: vFields[i] := WideString(Args[i].VWideString); vtWideChar: vFields[i] := Args[i].VWideChar; vtCurrency: vFields[i] := Args[i].VCurrency^; vtVariant: vFields[i] := Args[i].VVariant^; vtInt64: vFields[i] := Args[i].VInt64^; vtInterface: vFields[i] := string(Args[i].VInterface); end; V[Count] := vFields; end; function ReplaceChar(const str: string; SourceChar, DestChar: Char): string; begin Result := str; while Pos(SourceChar, Result) > 0 do Result[Pos(SourceChar, Result)] := DestChar; end; function IsPrintabledChar(Ch: Word): Boolean; begin Result := (Ch > 31) and (Ch < 127); end; function GetUniqueNumber: Integer; begin inc(_UniqueNumber); Result := _UniqueNumber; end; function GetAppBarScale: TPoint; var abd: TAppBarData; begin abd.cbSize := sizeof(abd); SHAppBarMessage(ABM_GETTASKBARPOS, abd); Result.X := abd.rc.Right - abd.rc.Left; Result.Y := abd.rc.Bottom - abd.rc.Top; end; function FirstDelimiter(const Delimiters, S: string): Integer; var P: PChar; begin Result := 1; P := PChar(Delimiters); while Result < Length(S) do begin if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then if (ByteType(S, Result) = mbTrailByte) then inc(Result) else Exit; inc(Result); end; end; function extractRealFileName(const fileName: string): string; var iTemp: Integer; begin Result := fileName; iTemp := LastDelimiter('.', Result); Delete(Result, iTemp, Length(Result) - iTemp + 1); end; function getModuleVersion(appInstance: Cardinal): string; var Size, Size2: DWord; Pt, Pt2: Pointer; begin Size := GetFileVersionInfoSize(PChar(GetModuleName(appInstance)), Size2); if Size > 0 then begin GetMem(Pt, Size); try GetFileVersionInfo(PChar(ParamStr(0)), 0, Size, Pt); VerQueryValue(Pt, '\', Pt2, Size2); with TVSFixedFileInfo(Pt2^) do begin Result := IntToStr(HiWord(dwFileVersionMS)) + '.' + IntToStr(LoWord(dwFileVersionMS)) + '.' + IntToStr(HiWord(dwFileVersionLS)) + '.' + IntToStr(LoWord(dwFileVersionLS)); end; //while finally FreeMem(Pt); end; //finally end; end; function int2Bin(Value: cardinal): string; var i: Integer; begin SetLength(result, 32); for i := 1 to 32 do begin if ((Value shl (i - 1)) shr 31) = 0 then result[i] := '0' {do not localize} else result[i] := '1'; {do not localize} end; end; function AddStr(sourcestr: string; Len: Integer; AddStr: Char; Eof: Boolean = False): string; begin while Length(sourcestr) < Len do begin if Eof then sourcestr := sourcestr + AddStr else sourcestr := AddStr + sourcestr; end; Result := sourcestr; end; function generateGUID: TGUID; begin if CoCreateGuid(Result) = S_OK then Exit else raise exception.Create('GUID 获取失败'); end; function generateGUIDString: string; begin result := GUIDToString(generateGUID); end; function generateGUIDKey: string; begin Result := generateGUIDString; delete(Result, 1, 1); delete(Result, length(Result), 1); Result := StringReplace(Result, '-', '', [rfReplaceAll, rfIgnoreCase]); end; function cloneString(const str: string; const cloneCount: Integer): string; var i: Integer; begin if (_cachedCloneString.cloneStr = str) and (_cachedCloneString.count = cloneCount) then Result := _cachedCloneString.result else begin _cachedCloneString.result := ''; _cachedCloneString.count := cloneCount; _cachedCloneString.cloneStr := str; for i := 0 to cloneCount - 1 do begin _cachedCloneString.result := _cachedCloneString.result + str; end; //i Result := _cachedCloneString.result; end; end; function var2Int(const v: variant; const def: integer = 0): Integer; begin Result := strToIntDef(varToStr(v), def); end; function RemoveEditFormat(EditMask: TEditMask; const Value: string; MaskBlank: Char): string; var I: Integer; OldLen: Integer; Offset, MaskOffset: Integer; CType: TMaskCharType; Dir: TMaskDirectives; begin Offset := 1; Result := Value; for MaskOffset := 1 to Length(EditMask) do begin CType := MaskGetCharType(EditMask, MaskOffset); if CType in [mcLiteral, mcIntlLiteral] then Result := Copy(Result, 1, Offset - 1) + Copy(Result, Offset + 1, Length(Result) - Offset); if CType in [mcMask, mcMaskOpt] then Inc(Offset); end; Dir := MaskGetCurrentDirectives(EditMask, 1); if mdReverseDir in Dir then begin Offset := 1; for I := 1 to Length(Result) do begin if Result[I] = MaskBlank then Inc(Offset) else break; end; if Offset <> 1 then Result := Copy(Result, Offset, Length(Result) - Offset + 1); end else begin OldLen := Length(Result); for I := 1 to OldLen do begin if Result[OldLen - I + 1] = MaskBlank then SetLength(Result, Length(Result) - 1) else Break; end; end; if MaskBlank <> ' ' then begin OldLen := Length(Result); for I := 1 to OldLen do begin if Result[I] = MaskBlank then Result[I] := ' '; if I > OldLen then Break; end; end; end; function nvl(const obj: TObject; const val1, val2: string): string; begin Result := ifReturn(obj <> nil, val1, val2); end; function nvl(const obj: TObject; const val1, val2: Integer): Integer; begin Result := ifReturn(obj <> nil, val1, val2); end; function nvl(const obj: TObject; const val1, val2: double): double; begin Result := ifReturn(obj <> nil, val1, val2); end; function nvl(const obj: TObject; const val1, val2: TObject): TObject; begin Result := ifReturn(obj <> nil, val1, val2); end; function nvl(const obj: TObject; const val1, val2: IInterface): IInterface; begin Result := ifReturn(obj <> nil, val1, val2); end; function nvl(const obj: TObject; const val1, val2: Char): Char; begin Result := ifReturn(obj <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: string): string; begin Result := ifReturn(intf <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: Integer): Integer; begin Result := ifReturn(intf <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: double): double; begin Result := ifReturn(intf <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: TDatetime): TDateTime; begin Result := ifReturn(intf <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: TObject): TObject; begin Result := ifReturn(intf <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: IInterface): IInterface; begin Result := ifReturn(intf <> nil, val1, val2); end; function nvl(const intf: IInterface; const val1, val2: Char): Char; begin Result := ifReturn(intf <> nil, val1, val2); end; function ifReturn(const check: boolean; const val1, val2: string): string; begin if check then Result := val1 else Result := val2; end; function ifReturn(const check: boolean; const val1, val2: Integer): Integer; begin if check then Result := val1 else Result := val2; end; function ifReturn(const check: boolean; const val1, val2: double): double; begin if check then Result := val1 else Result := val2; end; function ifReturn(const check: boolean; const val1, val2: TObject): TObject; begin if check then Result := val1 else Result := val2; end; function ifReturn(const check: boolean; const val1, val2: IInterface): IInterface; begin if check then Result := val1 else Result := val2; end; function ifReturn(const check: boolean; const val1, val2: Char): Char; begin if check then Result := val1 else Result := val2; end; function filePath2UrlPath(const filePath: string): string; begin Result := 'file:///' + StringReplace(filePath, '\', '/', [rfReplaceAll, rfIgnoreCase]); end; function strRight(const s: string; count: Integer): string; begin Result := Copy(s, Length(s) - count + 1, count); end; function strHasSuffix(const S, subStr: string): boolean; var Test: string; begin test := strRight(s, length(subStr)); Result := SameText(test, subStr); end; procedure parserFtpUrl(const AFtpUrl: string; out AHost, AUser, APassword, AUrl: string; out APort: Integer; ADefaultPort: Integer = 21); const C_FTP_HEADER = 'ftp://'; var sUrl, sUserStr: string; sTemp: string; begin {ftp://ftpguest:123@localhost:8022/publicfiles/downloadfields/demo.inf} sUrl := LowerCase(AFtpUrl); APort := ADefaultPort; StrTokenStr(sUrl, C_FTP_HEADER); if pos('@', sUrl) > 0 then begin sUserStr := strToken(sUrl, '@'); if sUserStr <> '' then begin AUser := StrTokenStr(sUserStr, ':'); APassword := sUserStr; end; end; if Pos(':', sUrl) > 0 then begin sTemp := strToken(sUrl, ':'); AHost := sTemp; sTemp := strToken(sUrl, '/'); if sTemp <> '' then APort := StrToIntDef(sTemp, ADefaultPort); end else AHost := strToken(sUrl, '/'); // AUrl := '/' + sUrl; AUrl := sUrl; end; procedure setSystemTime(const aTime: TTime); var tmTemp: TSystemTime; begin DateTimeToSystemTime(aTime, tmTemp); SetLocalTime(tmTemp); end; procedure setSystemDate(const aDate: TDate); var dtTemp: TSystemTime; begin DateTimeToSystemTime(aDate, dtTemp); SetLocalTime(dtTemp); end; procedure setSystemDateTime(const aDateTime: TDateTime); var dtTemp: TSystemTime; begin DateTimeToSystemTime(aDateTime, dtTemp); SetLocalTime(dtTemp); end; function readFromFile(const fileName: string): string; var iSize: Integer; stream: TFileStream; begin stream := TFileStream.Create(fileName, fmOpenRead or fmShareDenyWrite); try iSize := stream.Size - stream.Position; setString(Result, nil, iSize); stream.Read(Pointer(Result)^, iSize); finally freeandnil(stream); end; //finally end; function listFiles(const path, fileMask: string): TStrings; var bFound: Integer; sr: TSearchRec; begin result := TStringList.Create; bFound := FindFirst(path + fileMask, 0, sr); try while bFound = 0 do begin result.Add(sr.Name); bFound := FindNext(sr); end; finally findClose(sr); end; //finally end; function listDirs(const path: string): TStrings; var bFound: Integer; sr: TSearchRec; begin result := TStringList.Create; bFound := FindFirst(path + '\*.*', faDirectory, sr); try while bFound = 0 do begin if (sr.Name <> '.') and (sr.Name <> '..') then result.Add(sr.Name); bFound := FindNext(sr); end; finally findClose(sr); end; //finally end; function deleteDirAndFiles(const path: string): boolean; var fo: TSHFILEOPSTRUCT; begin FillChar(fo, SizeOf(fo), 0); with fo do begin Wnd := 0; wFunc := FO_DELETE; pFrom := PChar(path + #0); pTo := #0#0; fFlags := FOF_NOCONFIRMATION + FOF_SILENT; end;//while Result := (SHFileOperation(fo) = 0); end; initialization _UniqueNumber := 0; ZeroMemory(@_cachedCloneString, sizeOf(_cachedCloneString)); end.
发表评论
-
FastReport中如何实现自定义预览窗口关闭事件
2018-06-22 02:05 1350.... interface uses ... ... -
Chrome核心的自定义浏览器
2017-07-04 17:19 831以Chrome为核心的自定义浏览器源代码,有时候可能用得到,保 ... -
一个基于Chrome核心的浏览器源代码(delphi)
2017-05-12 11:27 2798有时候难免会需要自己做个个性化浏览器玩玩,基于IE或Edg ... -
Delphi开发ActiveForm,FEvents=nil的解决
2013-06-13 12:44 1530使用Delphi开发一个ActiveForm,其他功能都没 ... -
Delphi在二进制文件头部加数据或删除数据
2013-04-05 22:05 1883今天想要在一个二进制文件头部加上一个特殊标志,在后续处理时又 ... -
AES加密算法实现
2013-04-04 20:40 2005http://en.wikipedia.org/wiki/AE ... -
收藏几个条码组件的地址
2013-03-30 22:10 1540http://www.codeproject.com/Ar ... -
在Delphi中使用Zebra条码打印机打印中文
2013-03-15 13:53 2783在Delphi中使用条码打印机打印中文标签时,由于多数打印 ... -
一堆非关系数据库
2013-03-04 16:35 1087发现一个网站,里面里堆的非关系数据库,如果全弄熟了,该 ... -
用VB调用Office OCR组件实现图文识别
2011-12-30 11:11 10944Option Explicit '利 ... -
一些利用开源浏览器核心开发专用浏览器的连接
2011-12-02 14:36 3693D-Gecko: http://sourceforge.ne ... -
在Windows服务器上解决SVN不允许修改日志说明的问题
2011-10-28 09:06 3965昨天,我想在SVN上修改一个文件的注释,但提交时提示: DA ... -
演示EmbeddedWB(D5-D2009)组件如何通过GetExternal事件来达到从WEB页面控制浏览器的功能
2010-12-22 23:29 2907本例子是演示EmbeddedWB(D5-D2009)组件如何通 ... -
Delphi实现的网页绝对定位打印控件(自用)
2010-12-21 15:29 1672保存一个Delphi实现的网页绝对定位打印控件,只适用IE。 -
保存一个工具,以后也许能用上
2010-10-29 03:12 1129VclSkin 5.03 Fullsource(源码),谁用谁 ... -
FastReport4.8.11安装
2010-01-03 22:35 37411、把压缩文件内的Fa ... -
Delphi 编写BHO在HTTP头增加自定义属性
2009-09-17 16:39 2308把代码贴上(注意:中间省掉了一些类似 DoTitleChang ...
相关推荐
总结来说,XMLIniFiles.pas是Delphi环境下针对XML配置文件的一个实用工具,它简化了XML文件的读写操作,让开发者能够像处理.INI文件一样处理XML,同时享受到XML带来的更丰富的数据表示能力。通过使用这个类库,项目...
继承自TIniFile类的TXMLIniFile,可以方便的读写XMLIniFile配置文件,IniFile配置文件局限于字符长度,特殊字符等。而XMLIniFile就随心所欲很多
本主题将深入探讨如何在Delphi中进行XML配置文件的读写操作。 XML是一种标记语言,用于存储和传输数据,它的结构化特性使得数据能够被机器和人类同时理解。在Delphi中,我们可以利用内置的XML DOM库(Document ...
配置文件通常以XML或JSON格式存在,因为它们结构清晰,易于解析。本实例将详细介绍如何在Android中进行读取和写入配置文件的操作。 首先,Android提供了SharedPreferences接口,它是用于存储轻量级数据的首选方式,...
XML(eXtensible Markup Language)则是一种用于存储和传输数据的标准化格式,广泛应用于数据交换、配置文件以及Web服务等场景。当我们需要在Delphi应用中处理XML时,可以利用其内置的XML处理组件和库,如...
XML(eXtensible Markup Language)是一种结构化数据存储格式,常用于数据交换、配置文件或序列化对象。本项目"xml多个文件合并(delphi)"提供了Delphi操作XML文件的示例代码,帮助开发者了解如何在Delphi中合并多...
XML是一种标记语言,用于存储和传输数据,具有自我描述性,广泛应用于数据交换、配置文件以及Web服务等领域。它通过标签来定义数据结构,使得数据具有一定的语义。 NativeXML是Delphi社区中流行的一个XML处理组件,...
在Delphi中处理XML文件是一项常见的任务,XML(Extensible Markup Language)因其结构化和可扩展性而被广泛用于数据交换、配置存储等场景。本篇文章将深入探讨如何使用Delphi进行XML文件的读取、写入、删除和修改...
通过以上步骤,你可以实现Delphi应用中XML配置文件的读取、修改和保存。这只是一个基础示例,实际项目中可能需要处理更复杂的结构,如嵌套节点、属性等。Delphi的TXMLDocument组件提供了丰富的功能,足以应对大多数...
在Delphi编程环境中,处理JSON和XML数据是常见的任务,特别是在与Web服务交互或存储配置信息时。本文将深入探讨Delphi中用于解析JSON和XML的类,以及如何使用它们。 首先,我们来看JSON(JavaScript Object ...
标题中的“非常好用的Delphi的XML解析类”指的是在Delphi编程环境中,存在一个高效且易用的XML解析库。Delphi是Object Pascal的一种现代实现,它提供了一个强大的集成开发环境(IDE)和丰富的库支持,包括XML处理。...
XML(eXtensible Markup Language)是一种...无论是在配置文件、数据交换、存储结构化数据等方面,XML都是一个强大的工具。在实际开发中,根据项目需求选择合适的XML处理方法,可以显著提高程序的灵活性和可维护性。
XML(eXtensible Markup Language)是一种可扩展标记语言,广泛应用于数据交换、配置文件存储以及Web服务等场景。在Delphi中,XML是连接应用程序与外部数据的重要桥梁,通过Delphi的内置XML支持,开发者可以方便地...
以下是一个简单的示例,展示了如何使用TXMLDocument加载XML文件: ```delphi uses XMLDoc; var XMLDoc: TXMLDocument; begin XMLDoc := TXMLDocument.Create(nil); try XMLDoc.LoadFromFile('example.xml'); ...
- `lal_Update.dproj`:这是Delphi项目的配置文件,包含了关于项目设置、编译选项等信息。 - `lal_Update.identcache`:可能存储了关于项目标识的缓存信息,用于Delphi的版本控制集成。 - `lal_Update.dproj....
本“delphi xml读取demo”正是一个实例,旨在帮助开发者理解如何在Delphi 7中有效地读取XML文件。 首先,我们需要了解在Delphi 7中处理XML的基础组件:TXMLDocument。这是一个内置的组件,它基于MSXML库(Microsoft...
它实现了DOM(Document Object Model)模型,可以将整个XML文档加载到内存中形成一个树形结构,便于对XML进行遍历和修改。在程序中,首先需要创建一个XMLDocument对象,然后加载XML文件,例如: ```delphi var ...
在这个"XML_delphi.rar"压缩包中,我们看到的项目可能是一个简单的Delphi应用程序,名为"SendTest",它实现了将XML数据上传到服务器的功能。这个功能通常在需要向远程服务传递结构化数据时使用,例如在Web服务、API...
这个项目名为"通过xml树生成配置文件源码",显然是一个用Delphi编写的程序,其功能是将XML数据解析成一个可交互的TreeView组件,用户可以对其中的节点进行复选操作,这种功能在配置管理或设置界面设计中非常常见。...
4. **XML文件作为配置存储**:XML是一种结构化数据的存储格式,易于读写,适合保存和加载复杂配置。在本例中,可以将DBGrid的列配置信息(如列名、是否显示、宽度等)序列化为XML文件,以便在程序运行时恢复这些设置...