标签: delphi技巧

2021
文章

dcef4允许flash直接运行 cef3 84.4.1 Chromium 84.0.4147.105(直接启用不用点击)

问题出现chrome69版本开始禁用FLASH，cef3 84.4.1 Chromium 84.0.4147.105 如果正常开启FLASH，并且不用点击一点运行插件，就象之前版本一样呢？CEF4Delphi是在Delphi 10.2 Tokyo上开发和测试的，已经在Delphi 7，Delphi XE和Delphi 10中测试过了。有关CEF4Delphi的更多信息，请访问： https://www.briskbard.com/index.php?lang=en&pageid=cef论坛：https://www.briskbard.com/forum DELPHI代码实现 找到flash的dll文件 如在360浏览器中拷出flash文件PepperFlash NativeFlash放在程序目录 添加flash文件地址 123456789101112131415161718procedure CreateGlobalCEFApp;begin GlobalCEFApp := TCefApplication.Create; GlobalCEFApp.LogFile := 'debug.log'; GlobalCEFApp.LogSeverity := LOGSEVERITY_DISABLE;// LOGSEVERITY_INFO; 禁止日志文件 GlobalCEFApp.cache := 'User Data'; //设置缓存目录 GlobalCEFApp.UserDataPath := 'User Data'; GlobalCEFApp.LocalesRequired := 'zh-CN'; //设置语言 GlobalCEFApp.Locale := 'zh-CN'; GlobalCEFApp.UserAgent := 'Mozilla/5.0 (Linux; U; Android 4.0.4; en-gb; GT-I9300 Build/IMM76D) AppleWebKit/534.30 (KHTML, like Gecko) Version/4.0 Mobile Safari/534.30'; //设置全局agent为手机 GlobalCEFApp.FlashEnabled := true; //允许系统falsh GlobalCEFApp.AddCustomCommandLine('--ppapi-flash-path', 'PepperFlash\pepflashplayer.dll'); //指定flash GlobalCEFApp.AddCustomCommandLine('enable-npapi'); GlobalCEFApp.AddCustomCommandLine('load-plugin', 'NativeFlash\NPSWF32.dll'); GlobalCEFApp.AddCustomCommandLine('ssl-version-min','ssl3'); //指定ssl GlobalCEFApp.AddCustomCommandLine('--allow-running-insecure-content'); //允许https网站调用http的js GlobalCEFApp.EnablePrintPreview := True; //允许打印预览end; chromium启动时添加如下代码 123chromium1.AlwaysAuthorizePlugins := true;chromium1.AllowOutdatedPlugins := true;chromium1.RunAllFlashInAllowMode := true; 附加说明其中flash路径也可以使用dcef4的参数CustomFlashPath， 1GlobalCEFApp.CustomFlashPath := ExtractFilePath(Application.ExeName);

文章

CefSharp.84.4.1_支持Mp4包括X86和64

CefSharp84.4.1支持MP4，包括32位和64位_dcef4 84.4.1 cefsharp 支持mp3，mp4，H.264播放视频 版本：84.4.10 包含x64与x86 cef.redist.x64.84.4.1 cef.redist.x86.84.4.1 链接: 链接: https://pan.baidu.com/s/15lndNobZJ3mER2KVHgMTiA 提取码: ygga 使用方法 首先nuget安装cefsharp 84.4.10 安装完成后使用下载得到的文件中的【cef.redist.x64.84.4.1】、【cef.redist.x86.84.4.1】两个文件夹 替换【packages】原本的文件即可 测试站点http://html5test.com/ 百度网盘那蜗牛速度，下这200多M需要一个小时，现提供一个微云下载地址 链接：https://share.weiyun.com/Ue1izExT 密码：ecf6zi 就这东西，到处要积分下载！！！！ 对应cef 84.4.1的dcef3开源地址： https://github.com/salvadordf/CEF4Delphi/tree/84.0.4147.105

文章

Delphi实现类似Android锁屏的密码锁控件

手机锁屏之后，开屏的时候，要求咱们输入密码的那个滑动效果输入的控件。 Android的那个锁屏的效果，用过的人应该都知道是个什么效果，也就是横竖各3行，排列成九宫格的效果，然后由用户在上面滑动以此来达到密码输入进而进行解锁和加密的效果。那么首先，俺们可以分析一下，他的具体形成思路，实际上是很简单的，就是一个排列，然后根据滑动产生的内容形成密码来达到解密的目的，那么最主要的就是这个密码和他本身的密码是如何对应解密的，实际上很简单，咱们给他排列的九宫格，都固定好位置 1 2 34 5 67 8 9 就像这样，排列的给他的位置固定好，然后每一个格子表示一个字符或者说字符串，进而用户滑动的时候，将对应的位置序列进入到一个列表中去保存，然后鼠标放开的时候，那么入队的选择位置进行组合，那么就是对应的密码了，比如 这样的输入就是表示123，如此顺序记录，就可以形成密码了，然后用户进行滑屏录入之后和以前的进行比较就可以知道密码是否正确了，当然我这个组合是相当简单的，如果想要整的复杂，可以给每个顺序位置给定复杂的字符串，这样形成的密码就足够的复杂了！给一般人去看，也是看不明白的。 那么分析清楚了，思路也就简单了，鼠标按下的时候，开始可以滑动形成密码，鼠标按下的第一个点，作为队列的第一个，然后再滑过的就顺序的一一的记录到队列中，鼠标放开的时候，从队列中获取各个顺序位置，组合形成密码然后和原密码比对，判断密码是否正确！源码如下： 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313{ Delphi实现的类似Android鼠标锁屏效果的控件 作者：不得闲 2012-7-23}unit AndroidLockControl;interfaceuses Windows,Classes,SysUtils,Graphics,Controls;type TDxLockItem = class private r: TRect; IsEnter: Boolean; IsChecked: Boolean; Value: AnsiChar; FRadio: TPoint; public constructor Create; end; TInPutPwdEvent = procedure(Sender: TObject;InputPwd: string) of object; TDxAndroidLock = class(TGraphicControl) private FItemSpace: Integer; FRowCount: Integer; FColCount: Integer; FItemRaidio: Integer; Items: TList; FUseNum: Boolean; FPassword: string; IsDown: Boolean; LastInItem: TDxLockItem; PwdItems: TList; FOnInputPwd: TInPutPwdEvent; procedure SetItemSpace(const Value: Integer); procedure SetItemRaidio(const Value: Integer); procedure SetUseNum(const Value: Boolean); protected procedure paint;override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure CalcItemRects; public constructor Create(AOwner: TComponent);override; destructor Destroy;override; property Password: string read FPassword write FPassWord; published property ItemSpace: Integer read FItemSpace write SetItemSpace default 10; property OnInputPwd: TInPutPwdEvent read FOnInputPwd write FOnInputPwd; property ItemRaidio: Integer read FItemRaidio write SetItemRaidio default 20; property UseNum: Boolean read FUseNum write SetUseNum; end;implementationuses pngimage;{$R LockRc.RES}var PngIn,PngOut: TPngImage;{ TDxAndroidLock }procedure TDxAndroidLock.CalcItemRects;var i,j: Integer; p: TPoint; r: TRect; item: TDxLockItem;begin p.Y := FItemRaidio; for i := 1 to 3 do begin p.X := FItemRaidio; r.Left := p.X - FItemRaidio;r.Top := p.Y - FItemRaidio; r.Right := p.x + FItemRaidio;r.Bottom := p.Y + FItemRaidio; for j := 1 to 3 do begin item := Items[3*(i-1)+j - 1]; item.Value := AnsiChar(3*(i-1)+j+48); item.FRadio := p; item.r := r; p.X := p.X + FItemRaidio * 2 + FItemSpace; r.Left := p.X - FItemRaidio;r.Right := p.X + FItemRaidio; end; p.Y := p.Y + FItemRaidio * 2 + FItemSpace; end;end;constructor TDxAndroidLock.create(AOwner: TComponent);var i: Integer;begin inherited; LastInItem := nil; PwdItems := TList.Create; FPassWord := ''; Items := TList.Create; FItemSpace := 10; FRowCount := 3; FColCount := 3; FItemRaidio := 20; Width := FItemRaidio * 2 * 3 + FItemSpace * 2; Height := FItemRaidio * 2 * 3 + FItemSpace * 2; for i := 0 to 8 do begin Items.Add(TDxLockItem.Create); end; CalcItemRects;end;destructor TDxAndroidLock.Destroy;begin while Items.Count > 0 do begin TDxLockItem(Items[Items.Count - 1]).Free; Items.Delete(Items.Count - 1); end; PwdItems.Free; inherited;end;procedure TDxAndroidLock.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin IsDown := Button = mbLeft; if IsDown then begin if LastInItem <> nil then begin LastInItem.IsChecked := IsDown; PwdItems.Add(LastInItem); end; Invalidate; end;end;procedure TDxAndroidLock.MouseMove(Shift: TShiftState; X, Y: Integer);var i: Integer; p: TPoint; OldInItem,Item: TDxLockItem;begin OldInItem := LastInItem; p := Point(x,y); LastInItem := nil; for i := 0 to items.Count - 1 do begin item := Items[i]; if PtInRect(Item.r,p) then begin LastInItem := Item; LastInItem.IsEnter := True; LastInItem.IsChecked := IsDown; Break; end; end; if LastInItem <> OldInItem then begin if OldInItem <> nil then OldInItem.IsEnter := False; if IsDown then begin if LastInItem <> nil then begin PwdItems.Add(LastInItem); end; Invalidate; end; end;end;procedure TDxAndroidLock.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);var i: Integer; item: TDxLockItem; Np: string;begin IsDown := False; for i := 0 to items.Count - 1 do begin item := Items[i]; item.IsChecked := False; end; for i := 0 to PwdItems.Count - 1 do Np := Np + TDxLockItem(PwdItems[i]).Value; PwdItems.Clear; Invalidate; if Assigned(FOnInputPwd) then FOnInputPwd(self,Np);end;procedure DrawLineArrow(canvas: TCanvas; p1, p2: TPoint);const l = 6; //箭头长度 w = 4; //箭头宽度var slope, angle: Double; points: array[0..2] of TPoint; Xl,b: Single;begin canvas.Brush.Color := canvas.Pen.Color; canvas.Brush.Style := bsSolid; canvas.MoveTo(p1.X,p1.Y); canvas.LineTo(p2.X,p2.Y); if (p2.Y <> p1.Y) and (P2.X <> p1.X) then begin xl := (P2.Y - p1.Y) / (P2.X - p1.X); b := p2.Y - xl * p2.X; p2.X := (p2.X - p1.X) div 2 + p1.X; p2.Y := Trunc(p2.X * xl + b); end else if p2.Y = p1.Y then p2.X := (p2.X - p1.X) div 2 + p1.X else P2.Y := (p2.Y - p1.Y) div 2 + p1.Y;//画箭头 points[0] := Point(p2.x, p2.y);//箭头顶点 if (p2.x - p1.x = 0) then begin //垂直 if (p2.y - p1.y > 0) then slope := -1 else slope := 1; points[1] := Point(p2.x - w, p2.y + Trunc(l * slope)); points[2] := Point(p2.x + w, p2.y + Trunc(l * slope)); end else begin //倾斜 slope := (p2.y - p1.y) / (p2.x - p1.x); angle := ArcTan(slope); if (p2.x - p1.x > 0) then angle := angle - PI; points[1] := Point(p2.x + trunc(l * cos(angle) - w * sin(angle)), p2.y + trunc(l * sin(angle) + w * cos(angle))); points[2] := Point(p2.x + Trunc(l * cos(angle) + w * sin(angle)), p2.y + Trunc(l * sin(angle) - w * cos(angle))); end; canvas.Polygon(points);end;procedure TDxAndroidLock.paint;var i: Integer; item,item1: TDxLockItem; r: TRect;begin if not IsDown then begin for i := 0 to Items.Count - 1 do begin item := items[i]; r.Left := item.FRadio.X - 5;r.Right := item.FRadio.X + 5; r.Top := item.FRadio.Y - 5;r.Bottom := item.FRadio.Y + 5; Canvas.Draw(r.Left,r.Top,pngIn); end; end else begin //绘制指向线条 Canvas.Pen.Width := 2; Canvas.Pen.Color := clGreen; for i := 0 to PwdItems.Count - 2 do begin item := PwdItems[i]; item1 := PwdItems[i + 1]; Canvas.MoveTo(item.FRadio.X,item.FRadio.Y); Canvas.LineTo(item1.FRadio.X,item1.FRadio.Y); DrawLineArrow(Canvas,item.FRadio,item1.FRadio); end; for i := 0 to Items.Count - 1 do begin item := items[i]; if item.IsChecked then begin Canvas.Draw(item.r.Left,item.r.Top,pngOut); end; r.Left := item.FRadio.X - 5;r.Right := item.FRadio.X + 5; r.Top := item.FRadio.Y - 5;r.Bottom := item.FRadio.Y + 5; Canvas.Draw(r.Left,r.Top,pngIn); end; end;end;procedure TDxAndroidLock.SetItemRaidio(const Value: Integer);begin FItemRaidio := Value;end;procedure TDxAndroidLock.SetItemSpace(const Value: Integer);begin FItemSpace := Value;end;procedure TDxAndroidLock.SetUseNum(const Value: Boolean);begin FUseNum := Value;end;{ TDxLockItem }constructor TDxLockItem.Create;begin r := Rect(0,0,0,0); IsEnter := False;end;initialization PngIn := TPngImage.Create; PngIn.LoadFromResourceName(Hinstance,'InnerGra'); PngOut := TPngImage.Create; PngOut.LoadFromResourceName(Hinstance,'Outer');finalization PngIn.Free; PngOut.Free;end. 运行之后的效果就是转载自: https://www.cnblogs.com/DxSoft/archive/2012/07/23/2604941.html

2018
文章

delphi如何实现php中的parse_url网址拆分函数?

php中拆分URL的一个很重要的函数就是parse_url();但在delphi如何不正则分析就可以实现如此方便的功能呢？实际上delphi的indy有一个单元实现此功能-IdURI单元，实现如下分拆 1234http://login:password@somehost.somedomain.com:8080/some_path/something.html?param1=val&param2=val#nose\__/ \___/ \______/ \_____________________/ \__/\_______________________/ \___________________/ \__/ | | | | | | | |Scheme Username Password Host Port Path Query Fragment 123456789101112131415161718uses ..., IdURI; var URI: TIdURI; URI := TIdURI.Create('http://login:password@somehost.somedomain.com:8080/some_path/something_else.html?param1=val&param2=val');try Protocol = URI.Protocol Username = URI.Username Password = URI.Password Host = URI.Host Port = URI.Port Path = URI.Path Query = URI.Paramsfinally URI.Free;end; 以下是使用InternetCrackUrl方法实现(依赖windows的WinInet库) 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758{$APPTYPE CONSOLE} uses Windows, SysUtils, WinInet; procedure ParseURL(const lpszUrl: string);var lpszScheme : array[0..INTERNET_MAX_SCHEME_LENGTH - 1] of Char; lpszHostName : array[0..INTERNET_MAX_HOST_NAME_LENGTH - 1] of Char; lpszUserName : array[0..INTERNET_MAX_USER_NAME_LENGTH - 1] of Char; lpszPassword : array[0..INTERNET_MAX_PASSWORD_LENGTH - 1] of Char; lpszUrlPath : array[0..INTERNET_MAX_PATH_LENGTH - 1] of Char; lpszExtraInfo : array[0..1024 - 1] of Char; lpUrlComponents : TURLComponents;begin ZeroMemory(@lpszScheme, SizeOf(lpszScheme)); ZeroMemory(@lpszHostName, SizeOf(lpszHostName)); ZeroMemory(@lpszUserName, SizeOf(lpszUserName)); ZeroMemory(@lpszPassword, SizeOf(lpszPassword)); ZeroMemory(@lpszUrlPath, SizeOf(lpszUrlPath)); ZeroMemory(@lpszExtraInfo, SizeOf(lpszExtraInfo)); ZeroMemory(@lpUrlComponents, SizeOf(TURLComponents)); lpUrlComponents.dwStructSize := SizeOf(TURLComponents); lpUrlComponents.lpszScheme := lpszScheme; lpUrlComponents.dwSchemeLength := SizeOf(lpszScheme); lpUrlComponents.lpszHostName := lpszHostName; lpUrlComponents.dwHostNameLength := SizeOf(lpszHostName); lpUrlComponents.lpszUserName := lpszUserName; lpUrlComponents.dwUserNameLength := SizeOf(lpszUserName); lpUrlComponents.lpszPassword := lpszPassword; lpUrlComponents.dwPasswordLength := SizeOf(lpszPassword); lpUrlComponents.lpszUrlPath := lpszUrlPath; lpUrlComponents.dwUrlPathLength := SizeOf(lpszUrlPath); lpUrlComponents.lpszExtraInfo := lpszExtraInfo; lpUrlComponents.dwExtraInfoLength := SizeOf(lpszExtraInfo); InternetCrackUrl(PChar(lpszUrl), Length(lpszUrl), ICU_DECODE or ICU_ESCAPE, lpUrlComponents); Writeln(Format('Protocol : %s',[lpszScheme])); Writeln(Format('Host : %s',[lpszHostName])); Writeln(Format('User : %s',[lpszUserName])); Writeln(Format('Password : %s',[lpszPassword])); Writeln(Format('Path : %s',[lpszUrlPath])); Writeln(Format('ExtraInfo: %s',[lpszExtraInfo]));end; begin try ParseURL('http://login:password@somehost.somedomain.com/some_path/something_else.html?param1=val&param2=val'); except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; readln;end. 以上运行输出效果Protocol : httpHost : somehost.somedomain.comUser : loginPassword : passwordPath : /some_path/something_else.htmlExtraInfo: ?param1=val&param2=val

文章

Delphi中那些容易混淆的基础知识

1. @、^、Addr、PointerDelphi(Pascal)中有几个特殊的符号，如@、^等，弄清楚这些符号的运行，首先要明白Delphi指针的一些基础知识：指针，是一个无符号整数（unsigned int），它是一个以当前系统寻址范围为取值范围的整数。指针对应着一个数据在内存中的地址，得到了指针就可以自由地修改该数据。指针的指针就是用来存放指针所在的内存地址的。明白了指针的基本含义，就容易理解它们之间 的区别了： @XX：取变量、函数或过程XX的地址（获取指针）； Addr(XX)：和@的作用类似，唯一的不同在于如果编译选项{$T-}没有打开，@返回的是一个通用的指针，如果编译选项打开了，@返回的是XX对应的指针，但Addr却不受此编译选项的约束。 ^：当它出现在类型定义的前面时如 ^typename 表示指向这种类型的指针; 当它出现在指针变量后边时 如 point^ 返回指针指向的变量的值; Pointer：无类型指针（对应PChar、PInteger等则为“有类型指针”）。通过这段代码则更容易区分它们：12345678varX, Y: Integer; // X and Y 整数类型P: ^Integer; // P 指向整数类型的指针beginX := 11; // 给 X 赋值P := @X; // 把 x的地址赋给pY := P^; // 取出p所指向的数值赋给yend; 第二行定义了两个变量X，Y。 第三行声明了P是指向整数类型的指针；意味着P能够指向X或者Y的地址。第五行赋给X值，第六行把X的地址赋给P。最后通过P指向的变量赋值给Y。此时，X和Y有相同的值。2. Char、Byte Char是一个字符，必须赋以字符如‘A’等； Byte是无符号整数，数值范围0~255。虽然字符实质上也是整数，但与C不同，Delphi中将他们划为两种不同的类型，各自遵从不同的运算。比如运算符+对于Byte是整数加法，对于Char则是字符连接成串。他们可以相互转化：Ord(‘A’)得到字符对应的整数，Chr(65)得到整数对应的字符。同理，就很好区分array of Byte和array of Char了。3. Move、CopyMemoryMove字面意思上是“移动”的意思，其实不然，在Delphi中Move更像是Copy：它可以复制一段内存片段到另外一段内存空间中。如下代码：1234567891011121314151617var source, dest : string;begin // Set up our starting string source := '123456789'; dest := '---------'; // Copy a substring from source into the middle of dest Move(source[5], dest[3], 4); // Show the source and destination strings ShowMessage('Source = '+source); ShowMessage('Dest = '+dest);end;//结果------------------//Source = 123456789//Dest = --5678--- 而CopyMemory则可以在Delphi的源码中看出端倪：1234procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);begin Move(Source^, Destination^, Length);end; 可以看出，CopyMemory其实也是调用了Move方法，但参数变了，CopyMemory参数是指针。当然，从源码还可以发现MoveMemory和CopyMemory是一模一样的功能。CopyMemory一般的使用方法为：123456789var buf1,buf2: array[0..9] of AnsiChar;begin buf1 := '0123456789'; buf2 := 'abcdefghij'; CopyMemory(@buf2[2], @buf1[4], 5); ShowMessage(buf1); {0123456789} ShowMessage(buf2); {ab45678hij}end; 4. GetMem和FreeMem、GetMemory和FreeMemory、New和Dispose、StrAlloc和StrDispose、AllocMemDelphi中的内存申请和释放方法比较多，但有一点儿需要牢记的是上述方法建议配对使用。GetMem和FreeMem与GetMemory和FreeMemory在Delphi的源码中可以看到是被调用和调用的关系，FreeMemory会判断指针是否为空：123456789101112function GetMemory(Size: Integer): Pointer; cdecl;begin Result := MemoryManager.GetMem(Size);end; function FreeMemory(P: Pointer): Integer; cdecl;begin if P = nil then Result := 0 else Result := MemoryManager.FreeMem(P);end; 因此，建议用GetMemory和FreeMemory代替GetMem和FreeMem。New和Dispose是用来管理变体类型内存分配，如变体结构体：12345TRecord = recordText: string;Value: Integer;end;PRecord = ^TRecord; 如果用GetMem和FreeMem、GetMemory和FreeMemory来释放，会造成Text的内存没有释放，造成内存泄漏。如果用Dispose来释放指针，要加上定义信息，否则造成内存泄漏，正确写法Dispose(PRecord(Point))。另外需要注意的一点是：Delphi设计的Dispose释放内存时，只是标记这部分内存可以再用来被New等函数分配，并不是把从系统申请到的内存归还给操作系统，只在程序结束时，才全部释放给操作系统，因此并不能在资源管理器中看到Dispose的“显著效果”。一般使用方法如下：12345678910111213141516Type　PMyRec = ^TMyRec;　TMyRec = record　　FName: string;　　LName: string;　end;var　MyRecPtr: PMyRec;　TreeViewIndex: LongInt;begin　New(MyRecPtr);　MyRecPtr^.FName := Edit1.Text;　MyRecPtr^.LName := Edit2.Text;　{其他处理}　Dispose(MyRecPtr);end; StrAlloc和StrDispose这个函数也是一对，他们分配PChar加一个Cardinal长度，因此一定要用StrDispose释放，否则容易造成4字节的内存泄漏。StrAlloc分配的指针可以使用StrBufSize来获得大小。AllocMem和GetMem的区别在于AllocMem在申请内存后会初始化这段内存（把内存全部初始化为#0），同样和FreeMem配对使用。

文章

delphi在ring3阻止文件删除(8圈桌面广告图标生成原理)

8圈网管计费系统，最近在桌面生成图标，直接删除会提示服务和应用管理程序已经打开，无法删除，8圈计费系统先生成url快捷图标，然后打开这个快捷方式取得句柄，再使用DuplicateHandle复制句柄丢给系统进程services.exe，达到占用文件，删除8圈桌面图标就不行了!8圈桌面图标阻止删除的方法关键地方就是使用了DuplicateHandle这个API，看看下面的代码! 12345678910111213141516171819202122232425262728293031323334353637383940414243function EnabledDebugPrivilege(const bEnabled: Boolean): Boolean;//提权varhToken: THandle;tp: TOKEN_PRIVILEGES;a: DWORD;constSE_DEBUG_NAME = 'SeDebugPrivilege';beginResult := False;if (OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken)) thenbegintp.PrivilegeCount := 1;LookupPrivilegeValue(nil, SE_DEBUG_NAME, tp.Privileges[0].Luid);if bEnabled thentp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLEDelsetp.Privileges[0].Attributes := 0;a := 0;AdjustTokenPrivileges(hToken, False, tp, SizeOf(tp), nil, a);Result := GetLastError = ERROR_SUCCESS;CloseHandle(hToken);end;end; function DupFile(FileName:String;PID:Cardinal):Boolean;varhFile,hProcess,hTarget:THandle;beginResult := False;EnabledDebugPrivilege(True);hProcess := OpenProcess(PROCESS_DUP_HANDLE, False, PID);Tryif hProcess <> 0 thenbeginhFile := CreateFile(PChar(FileName), GENERIC_READ, 0, nil, Create_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);if hFile = INVALID_HANDLE_VALUE then Exit;Result := DuplicateHandle(GetCurrentProcess(), hFile, hProcess, @hTarget,0, False, DUPLICATE_SAME_ACCESS or DUPLICATE_CLOSE_SOURCE);end;FinallyCloseHandle(hProcess);End;end; 8圈在桌面生成图标就是利用上面的原理!实际改一下就是这样 123456789101112131415161718192021222324252627282930313233343536procedure TForm1.btn2Click(Sender: TObject); function GetPid(ExeFileName: string): THandle; //根据进程名返回进程PID const PROCESS_TERMINATE = $0001; var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin Result :=FProcessEntry32.th32ProcessID; Break; end; ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end;var fhand:THandle; hProcess,hFile:THandle;begin fhand:=FileOpen(PWideChar(edt1.Text),GENERIC_READ);//取得阻止删除的文件句柄 EnabledDebugPrivilege; hProcess:=OpenProcess(PROCESS_ALL_ACCESS, FALSE, GetPid('services.exe')); if DuplicateHandle(GetCurrentProcess(), fhand,hProcess, @hFile, 0 ,FALSE, DUPLICATE_SAME_ACCESS) then ShowMessage('文件占坑成功!'); CloseHandle(hProcess);end;

文章

delphi如何根据句柄判断窗口的显示状态?

有时我们取得一个窗口的句柄，需要知道这个窗口是隐藏还是显示状态？或者我们取得窗体的句柄，想隐藏这个窗体或显示这个窗体，该怎么办呢？这时我们需要用到API函数GetWindowLong或者GetWindowInfo, GetWindowLong的函数原型LONG GetWindowLong( HWND hWnd,int nIndex )参数：hWnd：指定窗口的句柄nIndex：需要获得的信息的类型值 功能nIndex取值如下:GWL_EXSTYLE 得到扩展的窗口风格GWL_STYLE 得到窗口风格GWL_WNDPROC 得到窗口回调函数的地址，或者句柄。得到后必须使用CallWindowProc函数来调用GWL_HINSTANCE 得到应用程序运行实例的句柄GWL_HWNDPARENT 得到父窗口的句柄GWL_ID 得到窗口的标识符GWL_USERDATA 得到和窗口相关联的32位的值（每一个窗口都有一个有意留给创建窗口的应用程序是用的32位的值）当hWnd标识一个对话框时可以使用下面的值Value ActionDWL_DLGPROC 得到对话框回调函数的地址，或者句柄。得到后必须使用CallWindowProc函数来调用DWL_MSGRESULT 得到对话框回调函数中消息处理过程的返回值DWL_USER 得到额外的应用程序私有信息，如一些句柄和指针等返回值：成功时，返回一个请求的32位的值失败时，返回0，可以使用GetLastError来取得错误信息 示例1： 12345long nStyle = ::GetWindowLong(hWnd, GWL_STYLE); // hWnd是一个编辑框的句柄if(nStyle & ES_PASSWORD){AfxMessageBox(“这是一个密码域”);} 示例2： 1234LONG GetWindowLong(HWND hWnd, // handle of windowint nIndex // offset of value to retrieve); 第二个参数是0的话，就是指定GW_HWNDFIRST！！！GW_HWNDFIRST = 0; {同级别 Z 序最上}GW_HWNDLAST = 1; {同级别 Z 序最下}GW_HWNDNEXT = 2; {同级别 Z 序之下}GW_HWNDPREV = 3; {同级别 Z 序之上}GW_OWNER = 4; {属主窗口}GW_CHILD = 5; {子窗口中的最上} GetWindowInfo函数原型 BOOL WINAPI GetWindowInfo(__in HWND hwnd,__inout PWINDOWINFO pwi); 参数hwnd 要检索信息的窗口的句柄。pwi 指向一个接收信息的 PWINDOWINFO 结构，注意，在调用该函数之前必须设置 cbSize 成员为sizeof(WINDOWINFO)。]

2017
文章

delphi中如何设置dcef3的代理服务器setproxy?

代理服务器（Proxy Server）是一种重要的服务器安全功能，它的工作主要在开放系统互联(OSI)模型的会话层，从而起到防火墙的作用。代理服务器大多被用来连接INTERNET（国际互联网）和Local Area Network（局域网）。delphi中的tChromium控件dcef3如何设置代理服务器呢？ delphi中webbrowser设置代理服务器是这样的!1234567891011121314151617{------------------------------------------------------------------------------- 过程名: SetProcessProxy 作者: kelei 日期: 2013.08.03 参数: aProxyServer代理服务器; aProxyPort代理服务器端口 返回值: True设置成功 SetProcessProxy('127.0.0.1', 80);-------------------------------------------------------------------------------}function SetProcessProxy(const aProxyServer: string; const aProxyPort: Integer): Boolean;var vProxyInfo: TInternetProxyInfo;begin vProxyInfo.dwAccessType := INTERNET_OPEN_TYPE_PROXY; vProxyInfo.lpszProxy := PChar(Format('http=%s:%d', [aProxyServer, aProxyPort])); vProxyInfo.lpszProxyBypass := PChar(''); Result := UrlMkSetSessionOption(INTERNET_OPTION_PROXY, @vProxyInfo, SizeOf(vProxyInfo, 0) = S_OK;end; 在dcef3中如何静态设置代理服务器呢？静态设置方法在dpr中添加启动命令行参数，如果不添加命令行参数设置代理服务器，那么dcef3默认是使用的ie的代理服务器：123456789101112131415161718192021222324procedure AppendCefCmdline(const processType: ustring; const cmd: ICefCommandLine);begin cmd.AppendSwitchWithValue('proxy-server','http://218.189.26.20:8080');//设置http代理服务器 cmd.AppendSwitchWithValue('proxy-server','https://218.189.26.20:8082');//设置https代理服务器 cmd.AppendSwitchWithValue('proxy-server','ftp://218.189.26.20:21');//设置ftp代理服务器 cmd.AppendSwitchWithValue('proxy-server','socks://202.116.0.188:3128')//设置SOCKS代理服务器 cmd.AppendSwitchWithValue('proxy-server','sock4://202.116.0.188:1080')//设置sock4代理服务器 cmd.AppendSwitchWithValue('proxy-server','sock5://202.116.0.188:1081')//设置sock5代理服务器//cmd.AppendSwitchWithValue('proxy-server','direct://')//所有连接不使用代理//cmd.AppendSwitchWithValue('proxy-server','https=127.0.0.1:80;http=socks4://bnwin.com:1080')//同时设置https和sock4代理服务器 cmd.AppendSwitchWithValue('proxy-bypass-list','127.*,192.168.*,10.10.*,193.9.162.*');//不使用代理服务器的地址//cmd.AppendSwitch('--no-proxy-server');//禁止代理服务器//cmd.AppendSwitch('--proxy-auto-detect');//自动检测代理配置//cmd.AppendSwitchWithValue('proxy-pac-url','http://www.bnwinn.com/proxy.pac')//代理使用指定URL中的PAC文件//cmd.AppendSwitch('--winhttp-proxy-resolver');//代理在IE中运行正常,但在chrome中失败，可以添加此flagend; begin CefOnBeforeCommandLineProcessing :=AppendCefCmdline; //指定dcef启动命令行 Application.Initialize; Application.MainFormOnTaskbar := True; Application.CreateForm(TMainForm, MainForm); Application.Run;end. 在dcef3中如何动态设置代理服务器setproxy？前面已经说过，如果不在命令行中设置代理服务器，那么dcef是默认使用的ie代理服务器，要想动态设置代理服务器，我们不在dcef的命令行参数设置代理，然后使用开头的动态设置ie代理服务器的代码，dcef3的代理服务器就是动态的了！ 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556System network settingsThe Chromium network stack uses the system network settings so that users and administrators can control the network settings of all applications easily. The network settings include:proxy settingsSSL/TLS settingscertificate revocation check settingscertificate and private key storesSo far this design decision has worked well. The only network settings that some users ask for an alternative to system settings are proxy settings. For this we recently added some command-line options that allow you to run Chromium with custom proxy settings.Preference service for network settingsAlthough the system network settings have been sufficient for our network stack, eventually there will be some configuration settings specific to our network stack, so we need to have our own preference service for those settings. See also issue 266, in which some Firefox users demand that we not use the WinInet proxy settings (the de facto system proxy settings on Windows).Command-line options for proxy settingsChrome supports the following proxy-related command line arguments:–no-proxy-serverThis tells Chrome not to use a Proxy. It overrides any other proxy settings provided.–proxy-auto-detectThis tells Chrome to try and automatically detect your proxy configuration. This flag is ignored if –proxy-server is also provided.–proxy-server==[:][;…] | [:] | “direct://”This tells Chrome to use a custom proxy configuration. You can specify a custom proxy configuration in three ways:1) By providing a semi-colon-separated mapping of list scheme to url/port pairs.For example, you can specify:–proxy-server=”http=foopy:80;ftp=foopy2″to use HTTP proxy “foopy:80” for http URLs and HTTP proxy “foopy2:80″ for ftp URLs.2) By providing a single uri with optional port to use for all URLs.For example:–proxy-server=”foopy:8080”will use the proxy at foopy:8080 for all traffic.3) By using the special “direct://” value.–proxy-server=”direct://” will cause all connections to not use a proxy.–proxy-bypass-list=(|)[:][;…]This tells chrome to bypass any specified proxy for the given semi-colon-separated list of hosts. This flag must be used (or rather, only has an effect) in tandem with –proxy-server.Note that trailing-domain matching doesn’t require “.” separators so “*google.com” will match “igoogle.com” for example.For example,–proxy-server=”foopy:8080″ –proxy-bypass-list=”*.google.com;*foo.com;127.0.0.1:8080″will use the proxy server “foopy” on port 8080 for all hosts except those pointing to *.google.com, those pointing to *foo.com and those pointing to localhost on port 8080.igoogle.com requests would still be proxied. ifoo.com requests would not be proxied since *foo, not *.foo was specified.–proxy-pac-url=This tells Chrome to use the PAC file at the specified URL.For example,–proxy-pac-url=”http://wpad/windows.pac”will tell Chrome to resolve proxy information for URL requests using the windows.pac file.

文章

delphi中如何自定义dcef3的右键菜单？

delphi中TChromium控件dcef3的右键菜单默认是这样的如何修改成自己的菜单呢？或者自定义dcef3的右键菜单呢？ 在dcef3窗体中添加TApplicationEvents控件aplctnvnts1! 添加TPopupMenu控件pm1，并设置好自定义的dcef3的右键菜单及功能. 在TApplicationEvents控件的OnMessage事件中添加如下代码。1234567891011procedure TMainForm.aplctnvnts1Message(var Msg: tagMSG; var Handled: Boolean);var mPoint: TPoint;begin if IsChild(chrm1.Handle, Msg.Hwnd) and ((Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP)) then begin GetCursorPos(mPoint); //得到光标位置 pm1.Popup(mPoint.X, mPoint.Y); //弹出popupmenu的菜单 Handled := True; end;end; 这样你就不用让用户看TChromium的默认英文右键菜单了!对于TChromium默认右键菜单的功能，可以自己用代码很轻松的实现!

文章

delphi中如何删除dcef3的cookie和缓存？

我们用以下代码打开网站 12345678910var Chromium: TChromium;begin try Chromium := TChromium.Create(nil); Chromium.SetParentComponent(Form1); Chromium.Align := alClient; chromium.Browser.MainFrame.LoadUrl('www.bnwin.com'); FreeAndNil(Chromium)end; 如何删除dcef3的cookie和缓存？请看以下代码 123456789101112131415161718192021222324252627282930313233343536373839type CefTask = class(TCefTaskOwn) procedure Execute; override; public var url,cookieName: ustring; constructor create; virtual; end; constructor CefTask.create;begin inherited create; url := ''; cookieName := '';end; procedure CefTask.Execute;var CookieManager: ICefCookieManager;begin CookieManager := TCefCookieManagerRef.Global; CookieManager.DeleteCookies(url,cookieName);end; procedure c_WB_ClearCookies;var Task: CefTask;begin Task := CefTask.Create; CefPostTask(TID_IO, Task);end; // c_WB_Clear_url_Cookies('http://google.com','cookie_name');procedure c_WB_Clear_url_Cookies(c_url,c_cookieName: ustring);var Task: CefTask;begin Task := CefTask.Create; Task.url := c_url; Task.cookieName := c_cookieName; CefPostTask(TID_IO, Task);end; 整理自网站 https://stackoverflow.com/questions/12269587/how-do-i-clear-the-cache-and-cookies-for-an-embedded-chromium-browser 取得cookie并显示，如果需要删除cookie，把deleteCookie:= False改为deleteCookie:= True 123456789101112131415161718192021222324252627282930313233343536373839404142434445function VisitCookie (const name, value, domain, path: ustring; secure, httponly, hasExpires: Boolean;const creation, lastAccess, expires: TDateTime; count, total: Integer;out deleteCookie: Boolean): Boolean;begin deleteCookie:= False; MainForm.Memo1.Lines. Add (' cookie ' +inttostr (count) + ' / ' + inttostr (total)); MainForm.Memo1.Lines. Add (' name ' +name); MainForm.Memo1.Lines. Add (' value ' +value); MainForm.Memo1.Lines. Add (' domain ' +domain); MainForm.Memo1.Lines. Add (' path ' +path); MainForm.Memo1.Lines. Add (' secure ' +BoolToStr (secure)); MainForm.Memo1.Lines. Add (' httponly ' +BoolToStr (httponly)); MainForm.Memo1.Lines. Add (' hasExpires ' +BoolToStr (hasExpires)); MainForm.Memo1.Lines. Add (' creation ' +DateToStr (creation)); MainForm.Memo1.Lines. Add (' lastAccess ' +DateToStr (lastAccess)); MainForm.Memo1.Lines. Add (' expires ' +DateToStr (expires)); MainForm.Memo1.Lines. Add ('--------------- '); Result:= True;end; procedure TMainForm.btn2Click(Sender: TObject);var CookieManager: ICefCookieManager;beginCookieManager:= TCefCookieManagerRef.Global(nil);CookieManager.VisitAllCookiesProc (VisitCookie);end; //这样写，我在delphi xe8中编译不过procedure TMainForm.Button1Click(Sender: TObject);var CookieManager: ICefCookieManager;begin CookieManager := TCefCookieManagerRef.Global(nil); CookieManager.VisitAllCookiesProc( function(const name, value, domain, path: ustring; secure, httponly, hasExpires: Boolean; const creation, lastAccess, expires: TDateTime; count, total: Integer; out deleteCookie: Boolean): Boolean begin deleteCookie := True; ShowMessage('A cookie from domain ' + domain + ' will be unmercifully ' + 'deleted!'); end );end; 为网址设置单独的cookie文件 1234567891011121314CookieManager: ICefCookieManager; FormCreate:begin CookiesPath := ExtractFilePath(Application.ExeName) + 'cookies/bnwin'; CookieManager := TCefCookieManagerRef.Global(nil); CookieManager.SetStoragePath(CookiesPath, True, nil); Chromium1.Load（'bnwin.com'）; end; FormClose: begin CookieManager.FlushStore(nil);end 为指定的网站设置cookie