Delphi函数总结
Delphi函数总结
一、文件操作函数
1、 TextToFile
原型：function TextToFile(text, fname)
功能：保存内容到文件中
参数列表：
text 文本内容
fname 文本内容存放的文件名
返回结果：
暂无返回
源码：
var G_CS_TEXT_TO_FILE : TRTLCriticalSection;function TextToFile(strText, strFileName: string): string;
var
v, Path: string;
lineList: TStrings;
begin
EnterCriticalSection(G_CS_TEXT_TO_FILE);
//ShowMessage(strFileName);
//2015-04-16 17:43 tig 处理了js传过来的诸如\\\180.214.162.86\\McServer\奇怪的问题
//2015-04-17 05:09 HTS 马勒戈壁 这个问题处理了好久
//if copy(strFileName, 1, 3)='\\\' then strFileName:= copy(strFileName, 2, length(strFileName)-1);
if copy(strFileName, 1, 4)='\\\\' then strFileName:= StringReplace(strFileName,'\\','\',[rfReplaceAll,rfIgnoreCase]);
//ShowMessage(strFileName);
//2011-04-03 13:08 tig 判断所在目录是否存在, 如否则创建之
strFileName:= StringReplace(strFileName,'/','\',[rfReplaceAll,rfIgnoreCase]);
Path:= GetFilePath(strFileName);
if not DirectoryExists(Path) then ForceDirectories(Path);
try
//更改为普通文件
if FileExists(strFileName) then
FileSetAttr(strFileName, FILE_ATTRIBUTE_NORMAL);
lineList:= TStringList.Create;
lineList.Text:= strText;
lineList.SaveToFile(strFileName);
FreeAndNil(lineList);
finally
LeaveCriticalSection(G_CS_TEXT_TO_FILE);
end;
end;
//=============================================================================================================
2、 TextFromFile
原型：function TextFromFile(fname)
功能：从文件中读取内容
参数列表：
fname 文本内容存放的文件名
返回结果：
返回文件内文本内容源码：
//从文件中读取内容
function TextFromFile(strFileName: string): string;
var
lineList: TStrings;
begin
result:= '';
strFileName := StringReplace(strFileName,'/','\',[rfReplaceAll,rfIgnoreCase]);
if not FileExists(strFileName) then
exit;
lineList:= TStringList.Create;
lineList.LoadFromFile(strFileName);
result:= lineList.Text;
lineList.Free;
end;
//==========================================================================
3、 GetFileExt
原型：function GetFileExt(fname)
功能：获取文件后缀
参数列表：
fname 文件名称
返回结果：
返回文件后缀源码（javascript）：
function GetFileExt(fname)
{
var items = new Array();
items = fname.split(".");
return items[items.length-1];
}
//==========================================================================
4、Mc_GetImgSize
原型：functionMc_GetImgSize(fimage)
功能：获取图片尺寸
参数列表：
fimage 图片文件名
返回结果：
返回结果对象RET
RET.code
0 //取得图片尺寸
其他 //取图片尺寸错误
RET.desc
RET.code=0 //图片的长和宽,格式为：
源码：
//获取图片尺寸
function GetPictureSize(FPicture: string; var Width: integer; var Height: integer): TRESULT;
var
aBitmap :Graphics.TBitmap;
aGif :TGIFImage;
aJpeg :Tjpegimage;
aPng :TPNGObject;
strPicType :string;
Width1, Height1: word;
Begin
Width:= 0;
Height:= 0;
strPicType := GetPicType(FPicture);
if strPicType='error' then
begin
Exit;
end;
aBitmap := Graphics.Tbitmap.Create;
aGif := TGIFImage.Create;
aJpeg := TJPEGImage.Create;
aPng := TPNGObject.Create;
try
//...1、针对不同的类型进行转换，全部转换成 bmp
if strPicType='gif' then
begin
GetGIFSize(FPicture,Width1, Height1);
Width:= Width1;
Height:= Height1;
Exit;
end else
if (strPicType='jpg') or (strPicType='jpeg') then
begin
aJpeg.LoadFromFile(FPicture);
aBitmap.Assign(aJpeg);
end else
if strPicType='bmp' then
begin
aBitmap.LoadFromFile(FPicture);
end else
if strPicType='png' then
begin
aPng.LoadFromFile(FPicture);
aBitmap.Assign(aPng);
end else
begin
;
end;
Width:= aBitmap.Width;
Height:= aBitmap.Height;
finally
//...6、释放相关变量
FreeAndNil(aBitmap);
FreeAndNil(aGif);
FreeAndNil(aJpeg);
FreeAndNil(aPng);
end;
End;
//==========================================================================
5、Mc_MarkPicture
原型：functionMc_MarkPicture(markedPic, waterPic,ileft,itop)
功能：图片打水印
参数列表：
markedPic 待打水印图片路径
waterPic 水印图片路径
ileft 打水印区域的左边距
itop 打水印区域的上边距
返回结果：
打完水印后的图片路径源码：
//改为不覆盖原图
//水印图片缩放比例改为自动判断
//支持网络水印图片(url)
function MarkPicture(FBmpWater : string; //bmp格式水印图文件名称
FPicture : string; //待处理的图片(目前需要支持的格式: bmp, jpg/jpeg, gif)
Left : Integer=-1;
Top : Integer=-1;
AlphaValue : Integer=100;
TransColor : TColor=0;
ZoomScale : Integer=-1 //缩放比例： 10 表示 10%，水印是图片的10%
): TRESULT;
var
x ,y :Integer;
R ,Rs ,Rw ,G ,Gs ,Gw ,B ,Bs ,Bw:Integer;
Wcl ,Scl :TColor;
aBitmap :Graphics.TBitmap;
aGif :TGIFImage;
aJpeg :Tjpegimage;
aPng :TPNGObject;
picBitmap , Waterbmp :Graphics.TBitmap;
strPicType,strPicWaterType, v, v1 :string;
newWidth, newHeight, WidthScale:Integer;
Begin
result.Code:= 999;
//支持网络水印图片(url)
if trim(LowerCase(copy(FBmpWater, 1, 7)))='http://' then
begin
//是否有缓存
v:= GetAppPath()+'data\CONFIG.INI';
v:= IniItemRead(v, 'COMMON', 'McServer', '');
if v='' then
v:= GetAppPath()+'\data\Temp\waterimg\'
else
v:= v+'\waterimg\';
v1:= GetFileNameFromUrl(FBmpWater);
v1:= FieldValue('.', v1, 1);
v:= v+TrackDomain(FBmpWater)+'.'+v1;
//不存在则下载
if not FileExists(v) then
begin
result:= SmartDown(FBmpWater, nil);
if result.Code<>0 then exit;
CopyFile(PChar(result.Desc), PChar(v), TRUE);
end;
FBmpWater:=v;
end;
if not FileExists(FBmpWater) then
begin
result.Desc:= '水印图片不存在: '+FBmpWater;
Exit;
end;
if not FileExists(FPicture) then
begin
result.Desc:= '来源图片不存在: '+FPicture;
Exit;
end;
strPicType := GetPicType(FPicture);
if strPicType='error' then
begin
result.Desc:= 'GetPicType() 失败!';
Exit;
end else
if strPicType='gif' then
begin
result.Desc:= '暂不支持gif格式!';
exit;
end;
aBitmap := Graphics.Tbitmap.Create;
picBitmap := Graphics.Tbitmap.Create;
Waterbmp := Graphics.Tbitmap.Create;
aGif := TGIFImage.Create;
aJpeg := TJPEGImage.Create;
aPng := TPNGObject.Create;
//...1、针对不同的类型进行转换，全部转换成 bmp
if strPicType='gif' then
begin
aGif.LoadFromFile(FPicture);
aBitmap.Assign(aGif);
end else
if (strPicType='jpg') or (strPicType='jpeg') then
begin
aJpeg.LoadFromFile(FPicture);
aBitmap.Assign(aJpeg);
end else
if strPicType='bmp' then
begin
aBitmap.LoadFromFile(FPicture);
end else
if strPicType='png' then
begin
aPng.LoadFromFile(FPicture);
aBitmap.Assign(aPng);
end else
begin
//G.Log.WriteToFile('MarkPicture() 不支持的格式: '+FPicture);
//G.Log.WriteToHandle('MarkPicture() 不支持的格式: '+FPicture, G_MainHanlde);
end;
picBitmap.Assign(aBitmap); //图片
Waterbmp.LoadFromFile(FBmpWater);//水印
//...2、按比例进行缩放
//ZoomWaterBmp(Waterbmp,picBitmap,ZoomScale);
//先计算宽度, 在同等缩放高度, 避免变形
//HeightScale:= round(((aBitmap.Width/10)/Waterbmp.Width)*100);
//(aBitmap.Width/10)
//ZoomWaterBmp2(Waterbmp,picBitmap,WidthScale, WidthScale);
if ZoomScale=-1 then
begin
ZoomScale:=round(Waterbmp.Width/aBitmap.Width*100);
end;
newWidth:= round(aBitmap.Width*(ZoomScale/100));
newHeight:= round(Waterbmp.Height*(newWidth/Waterbmp.Width));
ZoomBmp(Waterbmp, newWidth, newHeight,Waterbmp);
//...3、生成默认水印位置
if (Left=-1) and (top=-1) then
begin
Left := picBitmap.Width - Waterbmp.Width;
Top := picBitmap.Height - Waterbmp.Height;
end;
//...4、打水印
For x:=0 to Waterbmp.Width-1 do
Begin
For y:=0 to Waterbmp.Height-1 do
Begin
Wcl:=Waterbmp.Canvas.Pixels[x,y];
//ShowMessage(FloatToStr(wcl)); //通过这句话找到那个 TransColor ，10进制的
IF (TransColor<>0) and (Wcl=TransColor) then Continue;
Rw:=GetRValue(ColorToRGB(Wcl));
Gw:=GetGValue(ColorToRGB(Wcl));
Bw:=GetBValue(ColorToRGB(Wcl));
Scl:=picBitmap.Canvas.Pixels[x+Left,y+Top];
Rs:=GetRValue(ColorToRGB(Scl));
Gs:=GetGValue(ColorToRGB(Scl));
Bs:=GetBValue(ColorToRGB(Scl));
R:=((AlphaValue*Rw)+((255-AlphaValue)*Rs))div 256;
G:=((AlphaValue*Gw)+((255-AlphaValue)*Gs))div 256;
B:=((AlphaValue*Bw)+((255-AlphaValue)*Bs))div 256;
picBitmap.Canvas.Pixels[x+Left,y+Top]:=RGB(R,G,B);
End;
End;
//...5、转换成对应的格式并存储到指定位置
//2010-03-27 18:51 改为不覆盖原图
FPicture:= GetAppPath()+'DATA\TEMP\'+ExtractFileName(FPicture);
if Pos('.gif',LowerCase(FPicture))>0 then
begin
aGif.Assign(picBitmap);
aGif.SaveToFile(FPicture);
end else
if (Pos('.jpeg',LowerCase(FPicture))>0) or (Pos('.jpg',LowerCase(FPicture))>0) then
begin
aJpeg.Assign(picBitmap);
aJpeg.SaveToFile(FPicture);
end else
if Pos('.bmp',LowerCase(FPicture))>0 then
begin
aBitmap.Assign(picBitmap);
aBitmap.SaveToFile(FPicture);
end else
if Pos('.png',LowerCase(FPicture))>0 then
begin
aPng.Assign(picBitmap);
aPng.SaveToFile(FPicture);
end;
//...6、释放相关变量
FreeAndNil(picBitmap);
FreeAndNil(aBitmap);
FreeAndNil(Waterbmp);
FreeAndNil(aGif);
FreeAndNil(aJpeg);
FreeAndNil(aPng);
result.Code:= 0;
result.Desc:= FPicture;
End;
//==========================================================================
6、Mc_ListFiles
原型：functionMc_ListFiles(path, key, fullName, childDir, max)
功能：根据给定的参数列出文件
参数列表：
path 指定路径
key 'txt', 'htm', 'xxx', or '*'(任意文件), 如为空, 表示目录/文件夹
fullName 列出的文件名称是否需要加上全路径
childDir 是否搜索子目录
max 最大数量
返回结果：
code 0=操作成功, 非0=操作失败
desc 返回相关信息或描述
调用例子：
//DEMO: var ret=ListFiles('Z:\\远程桌面\\', '*', true,true, 10); WriteLog(ret);
//DEMO:var ret=ListFiles('Z:\\', 'txt|xml'); WriteLog(ret);源码：
procedure ListFiles(strPath : string;
//FileType : string;
sKey : string;
Files : TStrings;
bFullName : boolean=true;
bChildDir : boolean=false;
iMaxFiles : integer=99999);
var
F : TSearchRec;
Found : Boolean;
NowFileType: string;
begin
if strPath='' then exit;
if not DirectoryExists(strPath) then exit;
ChDir(strPath);
if G.LogLevel>0 then G.Log.WriteAppLog('ListFiles(): '+GetCurrentDir, G.MainHanlde);
Found := (FindFirst('*.*', faAnyFile, F) = 0);
while Found do
begin
if (F.Name = '.') or (F.Name = '..') then
begin
Found := (FindNext(F) = 0);
Continue;
end;
if (F.Attr and faDirectory)>0 then
begin
if sKey = '' then
begin
if bFullName = true then
Files.Add(GetCurrentDir+'\'+F.Name)
else
Files.Add(F.Name);
end;
if bChildDir=true then
begin
Application.ProcessMessages;
ListFiles(F.Name, sKey, Files, bFullName, bChildDir);
end else
begin
Found:= (FindNext(F) = 0);
continue;
end;
end;
//插入你的代码，F.Name就是文件名，GetCurrentDir可以得到当前目录
NowFileType:= GetFileSuffix(F.Name);
if sKey = '*' then
begin
if bFullName = true then
Files.Add(GetCurrentDir+'\'+F.Name)
else
Files.Add(F.Name);
end else
if sKey <> '*' then
begin
//if ncpos(NowFileType, sKey)>0 then
if GetMatch(F.Name, sKey)<>'' then
begin
if bFullName = true then
Files.Add(GetCurrentDir+'\'+F.Name)
else
Files.Add(F.Name);
end
end;
Application.ProcessMessages;
Found := (FindNext(F) = 0);
//2009-06-01 增加
if Files.Count>= iMaxFiles then break;
end;
SysUtils.FindClose(F);
ChDir('..\');
end;
//==========================================================================
//.获取文件大小
function GetFileSize(const FileName: string):LongInt;
var
DataFile: TFileStream;
begin
if FileExists(FileName) then
//FileSetReadOnly(FileName, False)
else
begin
Result := 0;
Exit;
end;
Result := 0;
try
DataFile := TFileStream.Create(FileName, fmShareDenyNone);
Result := DataFile.Size;
finally
DataFile.Free;
end;
end;
二、数据库操作函数
三、字符串处理函数
function StreamToString(mStream: TStream): string;
var
I: Integer;
begin
Result := '';
if not Assigned(mStream) then
Exit;
SetLength(Result, mStream.Size);
for I := 0 to Pred(mStream.Size) do
try
mStream.Position := I;
mStream.Read(Result[Succ(I)], 1);
except
Result := '';
end;
end;
procedure StringToStream(s:string; mStream:TStream);
var
ssm:TStringStream;
begin
ssm:=TStringStream.create(s);
mStream.copyfrom(ssm, ssm.size);
ssm.Free;
end;
四、网络通信函数