hanCSDN的专栏

Eclipse 打包 JAR包 外部配置文件

Eclipse打包成JAR包读取外部JAR包和外部配置文件 Eclipse 打包 jar 外部JAR 外部配置文件

java通过线程控制程序执行超时(新) 基本数据类型 反射 线程 超时

java通过线程控制程序执行超时,多线程，反射

TPerson = class private Name:string; ListBox:TListBox; public constructor Create(AName:string;AListBox:TListBox); overload; constructor Create;overload; procedure Show;virtual; end; TFinery = class(TPerson) protected Component:TPerson; public procedure Decorator(Acomponent:TPerson); procedure Show;override; end; TShirts = class(TFinery) public procedure Show;override; end; TBigTrouser = class(TFinery) public procedure Show;override; end;

type TIProduct = class str:string; function Print():string;virtual; end; type TProduct_A = class(TIProduct) private public function Print():string;override; end; type TProduct_B = class(TIProduct) private public function Print():string;override; end; type TSimpleFactory = class private public function CreateProduct(A:string):TIProduct; end;

unit UnitMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Label1: TLabel; Edit1: TEdit; Button1: TButton; Label2: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var buffer:PChar;//存储空间 L:Integer;//密码框内容的长度 begin L:=GetWindowTextLength(Edit1.Handle);//取密码框内容的长度 GetMem(buffer,L+1);//分配内存空间，注意加1，因为ASCII码以"\0"结尾 SendMessage(Edit1.Handle,WM_GETTEXT,L+1,Integer(buffer)); Label2.Caption:=string(buffer);//显示 FreeMem(buffer);//释放内存 end; end.

function RecycleFile(sFileName:string):Boolean; var FOS:TSHFileOpStruct; begin FillChar(FOS,SizeOf(FOS),0);{记录清零} with FOS do begin wFunc:=FO_DELETE; //删除 pFrom:=PChar(sFileName); fFlags:=FOF_ALLOWUNDO; //移入回收站，而不是物理删除 end; Result:=(SHFileOperation(FOS)=0); end;

while SRI = 0 do begin if (SR.Name = '.') or (SR.Name = '..') then begin //不用做 end else if SR.Attr = faDirectory then begin if CheckBox1.Checked then begin Start(APath + '\' + sr.Name, SR.Name, ndRoot); end; end else begin Num := Num + 1; Label2.Caption := IntToStr(Num); ListBox1.Items.Add(SR.Name); nd := TreeView1.Items.AddChild(ndRoot, SR.Name); end; SRI := FindNext(SR); end;

program OnlyOne; uses Forms, Windows, Dialogs, UnitMain in 'UnitMain.pas' {Form1}; resourcestring FMutex = 'MUTEX_ONLY_ONE'; //互斥对象名 {$R *.res} var hMutex:HWND; iRet:Integer; begin

unit UnitMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, math, Buttons; type TRandomForm = class(TForm) Button1: TButton; Timer1: TTimer; EditPath: TEdit; ListBox1: TListBox; Button2: TButton; SpeedButton1: TSpeedButton; EditName: TEdit; OpenDialog: TOpenDialog; procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button1KeyPress(Sender: TObject; var Key: Char); procedure FormShow(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private s: TStringList; //从文件中读取数据 Current: Integer; //随机数产生的序号 Num: Integer; //数组中的数量 I: Integer; //序号 public // procedure LoadFile; // 装载文件 procedure GetNameValue; end;

InstallShield_新建Dialog

var Form1: TForm1; Hook:HHOOK; PlayHook:HHOOK; PlayLog:Integer; EventLog:Integer; EventArr:array[0..1000]of EVENTMSG; //记录鼠标时间 bDelay:Bool; implementation {$R *.dfm} function HookProc(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall; begin Result:=0; if iCode =1000 then begin UnHookWindowsHookEx(Hook); end; end; end; function HookPlayBack(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall; begin Result:=0; if iCode=EventLog then begin UNHookWindowsHookEx(PlayHook); end; end;

unit keyboard_hook; interface uses Windows,Messages; const WM_HookKEY=WM_USER+$1000; procedure HookOn;stdcall; procedure HookOff;stdcall; implementation var Hook:HHOOK; FileMapHandle:THandle; PViewInteger:^Integer; function CallHook(iCode:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall; begin if iCode=HC_ACTION then begin //打开映像文件 FileMapHandle:=OpenFileMapping(FILE_MAP_READ,False,'TestHook'); if FileMapHandle0 then begin //映射入内存中 PViewInteger:=MapViewOfFile(FileMapHandle,FILE_MAP_READ,0,0,0); //PViewInteger指向主程序句柄，WM_HookKEY是自定义消息 PostMessage(PViewInteger^,WM_HookKEY,wParam,lParam); UnmapViewOfFile(PViewInteger); CloseHandle(FileMapHandle); end; end; Result:=CallNextHookEx(Hook,iCode,wParam,lParam); end;

procedure TForm1.Button1Click(Sender: TObject); {设置键盘钩子} begin EnableKeyHook; //设置钩子 Button1.Enabled:=False; Button2.Enabled:=True; Button3.Enabled:=True; button4.Enabled:=True; Panel1.Caption:='键盘钩子已经设置'; end; procedure TForm1.Button2Click(Sender: TObject); begin DisableKeyHook; //卸载钩子 Button1.Enabled:=True; Button2.Enabled:=False; Button3.Enabled:=False; Button4.Enabled:=False; Panel1.Caption:='键盘钩子已经设置'; end;

procedure TForm1.FormCreate(Sender: TObject); begin TrayIcon1.Visible:=True; end; procedure TForm1.N1Click(Sender: TObject); begin Application.Terminate; end; procedure TForm1.TrayIcon1DblClick(Sender: TObject); begin Show; end;

function SetLayeredWindowAttributes(hwnd: HWND; crKey: Longint; bAlpha: byte; dwFlags: longint): longint; stdcall; external user32; //函数声明 implementation {$R *.dfm} procedure TForm1.btnCancelClick(Sender: TObject); begin Form1.Close; Application.Terminate; end; procedure TForm1.btnOkClick(Sender: TObject); begin if Edit1.Text = '' then begin ShowMessage('透明度不能为空！'); Edit1.SetFocus; edit1.SelectAll; Exit; end; //设置透明度 SetTMD(StrToInt(Edit1.Text)); end;

unit XMLexample; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, xmldom, XMLIntf, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, StdCtrls, Buttons, cxContainer, cxListBox, msxmldom, XMLDoc; type TForm1 = class(TForm) XMLDocument1: TXMLDocument; lstSource: TcxListBox; lstTarget: TcxListBox; SpeedButton2: TSpeedButton; SpeedButton1: TSpeedButton; SpeedButton3: TSpeedButton; SpeedButton4: TSpeedButton; SpeedButton6: TSpeedButton; SpeedButton5: TSpeedButton; SpeedButton7: TSpeedButton; SpeedButton8: TSpeedButton; Button1: TButton; cxListBox1: TcxListBox; cxListBox2: TcxListBox; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure SpeedButton6Click(Sender: TObject); procedure SpeedButton5Click(Sender: TObject); procedure SpeedButton7Click(Sender: TObject); private { Private declarations } public procedure MoveUp(A: TcxListBox); //上移 procedure MoveDown(A: TcxListBox); //下移 procedure DeleteItem(A: TcxListBox); //删除 procedure ReLoadItems(A: TcxListBox; const Flag: Integer = 0); //重置 procedure CreateXML(APath:string); end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin CreateXML('C:\Documents and Settings\Administrator\桌面\XML'); end; procedure TForm1.Button2Click(Sender: TObject); var Node: IXMLNode; Root: IXMLNode; //根节点 ParentNode: IXMLNode; //首节点 StrDir: string; xmlDocument: IXMLDocument; I: Integer; begin xmlDocument := TXMLDocument.Create(nil); StrDir := 'C:\Documents and Settings\Administrator\桌面\XMLConfig.xml'; xmlDocument.XML.LoadFromFile(StrDir); xmlDocument.Active := true; Root := xmlDocument.DocumentElement; //源字段 ParentNode:=Root.ChildNodes.FindNode('FieldsFromSource'); for I := 1 to ParentNode.ChildNodes.Count - 1 do begin Node:=ParentNode.ChildNodes[i]; cxListBox1.Items.Add(Node.ChildValues['FieldName']); end; //目标字段 ParentNode:=Root.ChildNodes.FindNode('FieldsFromTarget'); for I := 1 to ParentNode.ChildNodes.Count - 1 do begin Node:=ParentNode.ChildNodes[i]; cxListBox2.Items.Add(Node.ChildValues['FieldName']); end; end; procedure TForm1.CreateXML(APath: string); var xmlDocument: IXMLDocument; sDir: string; i:Integer; begin xmlDocument := TXMLDocument.Create(nil); with xmlDocument.XML do begin //开始写XML Add('<?xml version="1.0" encoding="GB2312"?>'); Add('<Config>'); //源字段信息写入XML if lstSource.Count>0 then begin Add('<FieldsFromSource>'); Add('<Number>' + IntToStr(lstSource.Count) + '</Number>'); for I := 0 to lstSource.Count - 1 do begin Add('<FieldInfo>'); Add('<Sequence>' + IntToStr(i) + '</Sequence>'); Add('<FieldName>'+ lstSource.Items[i]+'</FieldName>'); Add('<DisplayName_CN>'+ ''+'</DisplayName_CN>'); Add('<DisplayName_EN>'+ ''+'</DisplayName_EN>'); Add('<FieldType>'+ ''+'</FieldType>'); Add('<FieldSize>'+ ''+'</FieldSize>'); Add('</FieldInfo>'); end; Add('</FieldsFromSource>'); end else begin Add('<FieldsFromSource>'); Add('<Number>0</Number>'); Add('</FieldsFromSource>'); end; //目标字段写入XML if lstTarget.Count>0 then begin Add('<FieldsFromTarget>'); Add('<Number>' + IntToStr(lstTarget.Count) + '</Number>'); for I := 0 to lstTarget.Count - 1 do begin Add('<FieldInfo>'); Add('<Sequence>' + IntToStr(i) + '</Sequence>'); Add('<FieldName>'+ lstTarget.Items[i]+'</FieldName>'); Add('<DisplayName_CN>'+ ''+'</DisplayName_CN>'); Add('<DisplayName_EN>'+ ''+'</DisplayName_EN>'); Add('<FieldType>'+ ''+'</FieldType>'); Add('<FieldSize>'+ ''+'</FieldSize>'); Add('</FieldInfo>'); end; Add('</FieldsFromTarget>'); end else begin Add('<FieldsFromTarget>'); Add('<Number>0</Number>'); Add('</FieldsFromTarget>'); end; Add('</Config>'); //XML注释 Add('<!--FieldsFromSource 源字段 -->'); Add('<!--FieldsFromTarget 目标字段 -->'); Add('<!--FieldsInfo 字段信息 -->'); Add('<!--Number 字段数量 -->'); Add('<!--Sequence 序号 -->'); Add('<!--FieldName 字段名称 -->'); Add('<!--DisplayName_CN 中文名称 -->'); Add('<!--DisplayName_EN 英文名称 -->'); Add('<!--FieldType 字段类型 -->'); Add('<!--FieldSize 字段长度 -->'); //XML结束 end; xmlDocument.Active := True; sDir := APath; if not DirectoryExists(sDir) then begin if not CreateDir(sDir) then begin ShowMessage('创建文件夹失败'); Exit; end; end; xmlDocument.SaveToFile(sDir + 'Config.xml'); end; procedure TForm1.DeleteItem(A: TcxListBox); var _Index: Integer; begin with A do begin if (Items.Count > 0) and (ItemIndex <> -1) then begin _Index := ItemIndex; Items.Delete(_Index); end; end; end; procedure TForm1.MoveDown(A: TcxListBox); var CurrIndex, LastIndex: Integer; begin with A do begin CurrIndex := ItemIndex; LastIndex := Items.Count; if ItemIndex <> -1 then begin if CurrIndex + 1 < LastIndex then begin Items.Move(ItemIndex, (CurrIndex + 1)); ItemIndex := CurrIndex + 1; end; end; end; end; procedure TForm1.MoveUp(A: TcxListBox); var CurrIndex: Integer; begin with A do begin if ItemIndex > 0 then begin CurrIndex := ItemIndex; Items.Move(ItemIndex, (CurrIndex - 1)); ItemIndex := CurrIndex - 1; end; end; end; procedure TForm1.ReLoadItems(A: TcxListBox; const Flag: Integer); begin end; procedure TForm1.SpeedButton1Click(Sender: TObject); begin MoveDown(lstSource); end; procedure TForm1.SpeedButton2Click(Sender: TObject); begin MoveUp(lstSource); end; procedure TForm1.SpeedButton3Click(Sender: TObject); begin DeleteItem(lstSource); end; procedure TForm1.SpeedButton5Click(Sender: TObject); begin MoveDown(lstTarget); end; procedure TForm1.SpeedButton6Click(Sender: TObject); begin MoveUp(lstTarget); end; procedure TForm1.SpeedButton7Click(Sender: TObject); begin DeleteItem(lstTarget); end; end.

unit FrmProgressUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls; type TFrmProgress = class(TForm) ProgressBar: TProgressBar; procedure FormShow(Sender: TObject); private FProgressMin:Integer; FProgressMax:In

unit GetInternetTime; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComObj, DateUtils; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private public function GetInternetTime:string; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var InternetTime:string; begin InternetTime:=GetInternetTime; ShowMessage(InternetTime); end; function TForm1.GetInternetTime:string; var XmlHttp: Variant; datetxt: string; DateLst: TStringList; mon: string; timeGMT, GetNetTime: TDateTime; s: string; begin XmlHttp := CreateOleObject('Microsoft.XMLHTTP'); XmlHttp.Open('Get', 'http://www.baidu.com/', False); XmlHttp.send; datetxt := XmlHttp.getResponseHeader('Date'); datetxt := Copy(datetxt, Pos(',', datetxt) + 1, 100); datetxt := StringReplace(datetxt, 'GMT', '', []); datetxt := Trim(datetxt);

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit, dxSkinsCore, dxSkinsDefaultPainters, Menus, StdCtrls, cxButtons, cxTextEdit; type TForm1 = class(TForm) cxTextEdit1: TcxTextEdit; cxButton1: TcxButton; procedure cxButton1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; TDelphiDllFunc = function(Aint:Integer):Integer;stdcall; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.cxButton1Click(Sender: TObject); var i:Integer; DllHandle:THandle; Func: TDelphiDllFunc; begin DllHandle:=LoadLibrary('project1.dll'); try @Func:=GetProcAddress(DllHandle,'DelphiDll'); if Assigned(@Func) then begin i:=Func(11); cxTextEdit1.Text := IntToStr(i); end; finally FreeLibrary(DLLHandle); end; end; end.