delphi 常用方法

1、文件查找的方法

function Searchfile(path: string): TStringList;
var
  SearchRec: TSearchRec;
  found: integer;
begin
  Result := TStringList.Create;
  found := FindFirst(path + '\' + '*.*', faAnyFile, SearchRec);
  while found = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
      (SearchRec.Attr <> faDirectory) then
      Result.Add(SearchRec.Name);
    found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

2、通过文件名字获取Base64方法

function getBASE64_ByFile(const fileName: WideString): WideString;
var
  str:TStringstream;
  fstream:TFilestream;
begin
  //将bmp,jpeg 或其他 文件,返回BASE64编码
  result:='';
  if fileExists(fileName) then
  begin
    fstream := TFilestream.Create(fileName, fmOpenRead);
    str := TstringStream.create('');
    EncodeStream(fstream,str);
    result := str.DataString;
    fstream.free;
    str.free;
  end;
end;

3、通过进程名杀进程

procedure kill_all_proc(filename: string);
var
  i: integer;
  lppe: TProcessEntry32;
  found: boolean;
  Hand: THandle;
  dwProc: Cardinal;
  h: HWND;
begin
  Hand := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  lppe.dwSize := SizeOf(TProcessEntry32);
  found := Process32First(Hand, lppe);
  while found do
  begin
    if Trim(uppercase(StrPas(lppe.szExeFile))) = uppercase(filename) then
    begin
      dwProc := OpenProcess(PROCESS_ALL_ACCESS or PROCESS_TERMINATE, FALSE,
        dword(lppe.th32ProcessID));
      TerminateProcess(dwProc, 0);
    end;
    found := Process32Next(Hand, lppe);
  end;
end;

4、十六进制字符串转字符串

function HexToStr(const hMsg: String): String;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(hMsg) div 2 do
    Result := Result + Chr(StrToIntDef('0x'+ Copy(hMsg,(i-1)*2+1,2),0));

end;

5、字符串转DWORD,注意这里的字符串指接口等接收到的字符串。

function StrToWord(s: string): DWORD;
var
  I, c:integer;
begin
  Result := 0;

  c := Length(s);
  if c > 4 then
  begin
    s := Copy(s,1,4);
    c := 4;
  end;

  for I := 1 to c do
    Result:= Result + Round(IntPower(256,c-i)) * ord(s[i]);
end;

6、jpg图片压缩

procedure Compressjpg(filepath: string);
var
  JPEGImage: TJPEGImage;
  bmp: TBitmap;
begin
  try
    JPEGImage := TJPEGImage.Create;
    bmp := TBitmap.Create;
    JPEGImage.LoadFromFile(filepath);
    bmp.Width := JPEGImage.Width;
    bmp.Height := JPEGImage.Height;
    bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, JPEGImage);
    JPEGImage.Assign(bmp);
    JPEGImage.CompressionQuality:=StrToInt(ComboBox1.Text);
    JPEGImage.Compress;
    JPEGImage.SaveToFile(filepath);
    JPEGImage.free;
    bmp.free;
  except
  end;
end;

  • 1
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
搜索TXT 文件的示例unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Memo2: TMemo; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Label3: TLabel; Edit1: TEdit; ButtonSearchFile: TButton; FolderPath: TEdit; FileExt: TEdit; ProgressBar1: TProgressBar; procedure ButtonSearchFileClick(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } procedure SearchFile1(FileName: string; FindText: string); function MakeFileList(Path, FileExt: string): TStringList; function FileInUsed(FileName: TFileName): Boolean; public { Public declarations } end; var Form1: TForm1; implementation uses StrUtils; {$R *.dfm} { Search Options KeyWord in file FileName FileSize FileCreateTime FileModifyTime keyword filepath openfile found addListbox } var FileNamePathList, FileNameList: TStringList; procedure TForm1.FormCreate(Sender: TObject); begin FileNameList := TStringList.Create; FileNamePathList := TStringList.Create; end; { if FileInUsed ('D:\Administrator\Documents\MyProjects\FileSearch\Win32\Debug\Project1.exe') then ShowMessage('File is in use.') else ShowMessage('File not in use.'); } function TForm1.FileInUsed(FileName: TFileName): Boolean; var HFileRes: HFILE; begin Result := False; if not FileExists(FileName) then Exit; // 如果文件不存在,返回false HFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end; procedure TForm1.SearchFile1(FileName: string; FindText: string); var SearchList: TStringList; begin try SearchList := TStringList.Create; if FileExists(FileName) and (not FileInUsed(FileName)) then begin SearchList.LoadFromFile(FileName); if Boolean(Pos(UpperCase(FindText), UpperCase(SearchList.Text))) then begin FileNameList.Add(ExtractFileName(FileName)); FileNamePathList.Add(FileName); end; end; finally SearchList.Free; end; end; procedure TForm1.ButtonSearchFileClick(Sender: TObject); var I, n: Integer; List: TStringList; begin try ButtonSearchFile.Caption := 'SearchFile'; List := TStringList.Create; List.Clear; FileNameList.Clear; FileNamePathList.Clear; List := MakeFileList(FolderPath.Text, FileExt.Text); ProgressBar1.Max := List.Count; for I := 0 to List.Count - 1 do begin Application.ProcessMessages; SearchFile1(List[I], Edit1.Text); ProgressBar1.Position := I; end; ListBox1.Items.Text := FileNameList.Text; ButtonSearchFile.Caption := IntToStr(FileNamePathList.Count) + ' 条'; finally List.Free; end; end; { 这个过程得显示进度 } function TForm1.MakeFileList(Path, FileExt: string): TStringList; var sch: TSearchrec; begin Result := TStringList.Create; if RightStr(Trim(Path), 1) '\' then Path := Trim(Path) + '\' else Path := Trim(Path); if not DirectoryExists(Path) then begin Result.Clear; Exit; end; if FindFirst(Path + '*', faAnyfile, sch) = 0 then begin repeat Application.ProcessMessages; if ((sch.Name = '.') or (sch.Name = '..')) then Continue; if DirectoryExists(Path + sch.Name) then begin Result.AddStrings(MakeFileList(Path + sch.Name, FileExt)); end else begin if (UpperCase(ExtractFileExt(Path + sch.Name)) = UpperCase(FileExt)) or (FileExt = '.*') then Result.Add(Path + sch.Name); end; until FindNext(sch) 0; FindClose(sch); end; end; procedure TForm1.ListBox1Click(Sender: TObject); var s: string; txt: string; begin if not FileExists(FileNamePathList[ListBox1.ItemIndex]) then Exit; Memo2.Lines.LoadFromFile(FileNamePathList[ListBox1.ItemIndex]); Caption := FileNamePathList[ListBox1.ItemIndex]; txt := Form1.Memo2.Text; if Boolean(Pos(UpperCase(Edit1.Text), UpperCase(txt))) then begin Memo2.SetFocus; Memo2.SelStart := Pos(UpperCase(Edit1.Text), UpperCase(txt)) - 1; Memo2.SelLength := Length(Edit1.Text); end; end; end.
Delphi 跳出循环的几种方法Delphi 跳出循环的几种方法常用的几种方法 希望大家看看 那个是大家常用的而且比较不错的 以下是引用片段: Delphi中break,exit,abort跳出循环的比较 exit: 退出函数体 abort: 遇到异常,安静处理,就是不显示不提示 break: 退出当前循环体,包括for ,while, repeat等循环体 continue: 结束循环内的本次处理,继续从循环体的开始位置继续执行 Exit 是跳出当前代码块,也就是当前函数,跳出后是要继续向下执行的(如果有后续代码)。 Abort 是从 EAbort 过来的,可以激发 exception,其实质就是 Abort = RaiseException(),是一个不出现对话框的异常。所以 Abort 的行为和异常是一样的,其代码执行顺序也是follow异常的流程。 例如: try (1) //执行了 abort; (2) //不执行 exception (3) //执行了 end; 用 Abort 能够执行 exception 里边的代码,但是如果用 Exit,就直接离开,不管 exception。 delphi中表示跳出的有break,exit,abort。 【break】 离开循环 只能放在循环中 【exit】 跳出本模块(过程和函数),放在循环中是跳出循环在所在的模块。 【abort】 中止程序的运行,产生不报错的异常信息。跳出祖先模块。和【exit】的区别是 procedure p1; begin p2; p3; end; procedure p2; begin abort; //exit; end; procedure p3; begin //showmessage().. end; 如果用 Abort,则执行不到 P3,如果用 Exit 就能够执行到 P3。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值