顯示具有 Delphi 標籤的文章。 顯示所有文章
顯示具有 Delphi 標籤的文章。 顯示所有文章

2015年12月5日

Lazarus 

Lazarus 是基於Free Pascal 語言的開發環境
張貼者： 於 沒有留言:
標籤： , ,

2009年11月12日

AT Command Send Unicode Message

How to Send SMS Messages from a Computer
3GPP UMTS Specification Release 6

Unit1.pasunit Unit1;

interface

uses
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation
{$R *.xfm}

function WStrToHex(ws: WideString): string;
var
  i: integer;
begin
  Result := '';
  for i := 1 to Length(ws) do begin
    Result  := Format('%s%.4x', [Result, Word(ws[i])]);
  end;
  Result := Format('%.2x%s', [length(ws) * 2, Result]);
end;

function swapphone(Phone: string): string;
var
  b: Char;
  i, ln: Integer;
  Internationalnumber: Boolean;
  interstr: string;
begin
  Internationalnumber := Phone[1] = '+';
  ln := Length(Phone);
  if Internationalnumber then begin
    Result := PChar(@Phone[2]);
    Dec(ln);
  end else begin
    Result := Phone;
  end;
  if (ln mod 2) = 1 then begin
    Result := Result + 'F';
  end;
  i := 1;
  while (i < Length(Result)) do begin
    b := Result[i];
    Result[i] := Result[i + 1];
    Result[i + 1] := b;
    Inc(i, 2);
  end;
  if Internationalnumber then begin
    interstr := '91';
  end else begin
    interstr := '81';
  end;
    Result := Format('%.2x%s%s', [ln ,interstr ,Result]);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  msgstr: string;
  pln, mln: Integer;
begin
  msgstr := Format('0001FF%S0008%s',[
    swapphone(Edit3.Text), WStrToHex(Edit1.Text)]);
  Memo1.Clear;
  Memo1.Lines.Add(Format('AT+CMGW=%d',[(Length(msgstr) div 2) -1]));
  Memo1.Lines.Add(msgstr);
end;

end.
Unit1.dfmobject Form1: TForm1
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 4
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Binary Code'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Edit1: TEdit
    Left = 4
    Top = 8
    Width = 289
    Height = 21
    TabOrder = 1
    Text = '手機'
  end
  object Edit2: TEdit
    Left = 4
    Top = 60
    Width = 617
    Height = 21
    TabOrder = 2
  end
end
張貼者： 於 沒有留言:
標籤：

2009年5月30日

Delphi TJclAnsiRegEx

需先安裝 JEDI VCL for Delphi
和 Perl-compatible Regular Ex-pressions

將 \Program Files\GnuWin32\bin\pcre3.dll 複製到
   \WINDOWS\system32 目錄下，並更名為 pcre.dll
>copy "\Program Files\GnuWin32\bin\pcre3.dll" \WINDOWS\system32\pcre.dll

開啟 Delphi 在 Form Create 事件中加入
uses
 JclPCRE;

procedure TForm1.FormCreate(Sender: TObject);
var
  Re: TJclAnsiRegEx;
  s: string;
  i: Integer;
begin
  Memo1.Lines.Clear;
  Re := TJclAnsiRegEx.CReate;
  try
    Re.Compile('\d+', True, False);
    s := 'hello 1234 test 5678 number'#13#10'90';
    i := 1;
    while Re.Match(s, i) do
    begin
      Memo1.Lines.Add(Re.CaptuRes[0]);
      i := Re.CaptureRanges[0].LastPos +2;
    end;
  finally
    Re.FRee;
  end;
end;
{
1234
5678
90
}
張貼者： 於 沒有留言:
標籤：

Delphi JEDI CreateJunctionPoint (SymbolicLink) 


uses
  SysUtils, JclNTFS;

begin
  // function NtfsCreateJunctionPoint(const Source, Destination: string): Boolean;
  // Source must empty directory
  NtfsCreateJunctionPoint('c:\tmp\ProgramFiles', 'C:\Program Files');
  // Delete
  // NtfsDeleteJunctionPoint('c:\tmp\ProgramFiles');
end.
張貼者： 於 沒有留言:
標籤：

Delphi JEDI CreateHardLink 


uses
  SysUtils, JclNTFS;

begin
  NtfsCreateHardLink('C:\LINK_ODBC.INI', 'C:\WINDOWS\ODBC.INI');
end.
張貼者： 於 沒有留言:
標籤：

Delphi JEDI JvSearchFiles 


type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    procedure FindFile(Sender: TObject; const AName: String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  JvSearchFiles;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
  with TJvSearchFiles.Create(nil) do
  begin
    Files.Clear;
    Directories.Clear;
    DirOption := doIncludeSubDirs;
    Options := Options + [soOwnerData];
    FileParams.FileMasks.Text := '*.PAS';
    FileParams.SearchTypes := [stFileMask];
    RootDirectory := 'C:\JVCL333';
    OnFindFile := FindFile;
    Search;
    Free;
  end;
end;

procedure TForm1.FindFile(Sender: TObject;
  const AName: String);
begin
  Memo1.Lines.Add(AName);
end;
張貼者： 於 沒有留言:
標籤：

Delphi JEDI ScreenShot 擷取螢幕畫面到剪貼簿 


// 在 Form 上放入一個 Button 並加入 onclick 事件

uses
  JclGraphics, Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  AFormat: Word;
  AData: THandle;
  APalette: HPALETTE;
begin
   Bitmap := TBitmap.Create;
   try
     // Left, Top, Width, Height, HWND_DESKTOP
     ScreenShot(Bitmap, 0,0, 300, 200, HWND_DESKTOP);
     Bitmap.SaveToClipboardFormat(AFormat, AData, APalette);
     ClipBoard.SetAsHandle(AFormat, AData);
   finally
     Bitmap.Free;
   end;
end;
張貼者： 於 沒有留言:
標籤：

Delphi JEDI Form CaptionButton 


// ...
// 在 uses 中加入 JvCaptionButton
uses
  ... , JvCaptionButton;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
     // 加入 TJvCaptionButton 和 bonclick TNotifyEvent
     b: TJvCaptionButton;
     procedure bonclick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.bonclick(Sender: TObject);
begin
  ShowMessage('Hello');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  B := TJvCaptionButton.Create(self);
  B.Caption := 'A';
  B.onclick := bonclick;
end;

// ...

執行程式後 Caption 上就會多一個 'A' Button 了
張貼者： 於 沒有留言:
標籤：

Delphi JEDI TrayIcon Application

需先安裝 JEDI VCL for Delphi

加入元件
Jv Non-Visual -> JvTrayIcon
Standard -> PopupMenu
PopupMenu1 add MenuItem

設定元件屬性
MenuItem.Caption = Show
MenuItem.Name = Show1
JvTrayIcon1.Active = True
JvTrayIcon1.PopupMenu = PopupMenu1

// 加入 Show1 onclick 事件
procedure TForm1.Show1Click(Sender: TObject);
begin
  JvTrayIcon1.ShowApplication;
end;

// 加入 Form1 OnCreate 事件
procedure TForm1.FormCreate(Sender: TObject);
begin  
  JvTrayIcon1.HideApplication;
end;

執行程式後會直接隱藏到 TrayIcon 中
右鍵點 PopupMenu -> Show 還原視窗
張貼者： 於 沒有留言:
標籤：

Delphi JEDI JvDebugHandler 紀錄 Exception 資訊 (full stack trace) 


需先安裝 JEDI VCL for Delphi
先開啟 Map file
Project -> Options -> Linker -> Map file 選擇 Detailed 按 OK

放入元件 Jv System -> JvDebugHandler
放入元件 Memo

加入 Form1 OnCreate 事件

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
  try
    Format('%s', [3]);
  except

  end;
end;

加入 JvDebugHandler1 OnOtherDestination 事件

procedure TForm1.JvDebugHandler1OtherDestination(Sender: TObject);
begin
  Memo1.Lines.AddStrings(JvDebugHandler1.ExceptionStringList);
end;

執行程式並跳過 Exception
{ Memo
2008/3/29 下午 12:16:05 Exception EConvertError occured in ConvertErrorFmt at 0 in file 
Message: Format '%s' invalid or incompatible with argument
Call stack: 
[00408041] SysUtils.ConvertErrorFmt
[00409467] SysUtils.FmtStr
[00409412] SysUtils.Format
[0045EC2B] Unit1.TForm1.FormCreate (Line 32, "Unit1.pas")
[004470E1] Forms.TCustomForm.DoCreate
[00446DC1] Forms.TCustomForm.AfterConstruction
[0044E481] Forms.TApplication.CreateForm
[0045EFEF] Project1.Project1 (Line 11, "C:\Delphi7\Projects\Project1.dpr")

預設 JvDebugHandler.LogToFile = True
也會輸出 log file，預設檔名為 ${Application.Title} ERRORLOG.txt
可以直接設定 JvDebugHandler.LogFileName 來指定 log file 檔名
張貼者： 於 沒有留言:
標籤：

Delphi JEDI Persistence Form 


Add Components
  Jv Persistence -> JvAppIniFileStorage
  Jv Persistence -> JvFormStorage
  Jv Dialogs -> JvTipOfDay

Edit Object properties
  JvFormStorage1.AppStorage = JvAppIniFileStorage1
  JvAppIniFileStorage1.FileName = 'APP1.INI'
  JvTipOfDay1.AppStoragePath = 'TIP'
  JvTipOfDay1.Options = [toShowonstartUp, toUseAppStorage]
  JvTipOfDay1.AppStorage = JvAppIniFileStorage1
  JvTipOfDay1.Tips.Strings = (
    'Tips 1'
    'Tips 2'
    'Tips 3')

Run program show Tips
Exit program save APP.INI file
Re-run program read APP.INI file and change properties
張貼者： 於 沒有留言:
標籤：

Delphi JEDI TJvComputerInfoEx 取得系統資訊 


需先安裝 JEDI VCL for Delphi

uses
  JvComputerInfoEx;

procedure TForm1.FormCreate(Sender: TObject);
var
  JvComputerInfoEx1: TJvComputerInfoEx;
begin
  JvComputerInfoEx1 := TJvComputerInfoEx.Create(Self);
  with JvComputerInfoEx1, Memo1.Lines do
  begin
    Clear;
    Values['OS Name'] := OS.ProductName +' '+ OS.VersionCSDString;
    Values['CPU'] := CPU.Name;
    Values['Screen'] := Format('%d X %d', [Screen.Width, Screen.Height]);
    Values['Battery'] :=  Format('%d%%', [APM.BatteryLifePercent]);
    Values['Desktop'] := Folders.Desktop;
    Values['IPAddress'] := Identification.IPAddress;
    Values['DomainName'] := Identification.DomainName;
  end;
  JvComputerInfoEx1.Free;
end;
{ Memo1
OS Name=Microsoft Windows XP Service Pack 2
CPU=Intel(R) Core(TM)2 Duo CPU     T7300  @ 2.00GHz
Screen=1280 X 800
Battery=79%
Desktop=C:\Documents and Settings\Administrator\桌面
IPAddress=169.254.254.234
DomainName=SOLNONE
}
張貼者： 於 沒有留言:
標籤：

Delphi JEDI 增加、刪除 Windows 使用者帳號 


需先安裝 JEDI VCL for Delphi

建立 Delphi Console Application
File -> New -> Other... -> Console Application

輸入參數
Run -> Paramters...
Paramters 中輸入 Username Password

program Project1;
{$APPTYPE CONSOLE}

uses
  SysUtils, JclLANMan, System;

var
  Username: string;
  Password: string;
  Input: string;
begin
  if ParamCount < 2 then
  begin
    WriteLn(ExtractFileName(ParamStr(0)) + ' Username Password');
    ReadLn(Input);
    Exit;
  end;
  Username := ParamStr(1);
  Password := ParamStr(2);
  if CreateLocalAccount(Username, 'FullName',
    Password, 'Comment', 'HomeDir', 'Script') then
  begin
    WriteLn('Create User ' + Username + ' Success');
    if DeleteLocalAccount(Username) then
    begin
      WriteLn('Delete User ' + Username + ' Success');
    end
    else
    begin
      WriteLn('Delete User ' + Username + ' Success');
    end;
  end
  else
  begin
    WriteLn('Create User ' + Username + ' Failure');
  end;
  ReadLn(Input);
end.
{ Stdout
Create User Username Success
Delete User Username Success
}
張貼者： 於 沒有留言:
標籤：

Delphi JEDI MultiStringHolder 存多個 TStrings 


需先安裝 JEDI VCL for Delphi
在 Form 中
放入 TMemo 顯示訊息
放入 Jv Non-Visual -> TJvMultiStringHolder
加入 Form1 OnCreate 事件
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Add config
  with JvMultiStringHolder1.MultipleStrings.Add do
  begin
    Name := 'config';
    with Strings do
    begin
      Values['Server'] := 'localhost';
      Values['User'] := 'Solnone';
      Values['Access'] := 'ReadOnly';
    end;
  end;
  // Add users
  with JvMultiStringHolder1.MultipleStrings.Add do
  begin
    Name := 'users';
    with Strings do
    begin
      Add('Solnone');
      Add('May');
      Add('John');
    end;
  end;

  // Show
  with JvMultiStringHolder1 do
  begin
    Memo1.Lines := ItemByName['config'].Strings;
    Memo1.Lines.Add('------');
    Memo1.Lines.AddStrings(ItemByName['users'].Strings);
  end;
end;

{ Memo1
Server=localhost
User=Solnone
Access=ReadOnly
------
Solnone
May
John
}
張貼者： 於 沒有留言:
標籤：

Delphi JEDI CreateProcess 執行 Console 程式 


需先安裝 JEDI VCL for Delphi
在 Form 上
放入 Jv Non-Visual -> TJvCreateProcess
放入 TEdit, TButton 來執行 CommandLine
放入 TMemo 來顯示 Console 訊息
放入 TActionManager 來建立一個 Action
在 ActionManager1 雙擊滑鼠左鍵開啟 Editing ActionManager
新增一個 New Action [Inc]
加入 Action1 OnExecute 事件
procedure TForm1.Action1Execute(Sender: TObject);
var
  cmd: String;
  path: String;
begin
  with JvCreateProcess1 do
  begin
    case State of
      psReady: begin
        cmd := Edit1.Text;
        commandLine := cmd;
        path := ExtractFilePath(cmd);
        CurrentDirectory := path;
        Memo1.Clear;
        Run;
      end;
      psRunning,
      psWaiting: begin
        JvCreateProcess1.CloseApplication;
      end;
    end;
  end;
end;

加入 Action1 OnUpdate 事件
procedure TForm1.Action1Update(Sender: TObject);
begin
  with JvCreateProcess1 do
  begin
    case State of
      psReady: Button1.Caption := 'Run';
      psRunning, psWaiting: Button1.Caption := 'Close';
    end;
  end;
end;


加入 JvCreateProcess1 OnRead 事件 
procedure TForm1.JvCreateProcess1Read(Sender: TObject; const S: String;
  const StartsOnNewLine: Boolean);
begin
  Memo1.Lines.Add(S);
end;

修改屬性
Button1.Action = Action1
Edit1.Text = 'netstat -na'
JvCreateProcess1.StartupInfo.ShowWindow = swHide
JvCreateProcess1.StartupInfo.DefaultWindowState = False
JvCreateProcess1.ConsoleOptions = [coOwnerData, coRedirect]
Memo1.ScrollBars = ssBoth
Memo1.WordWrap = False

執行程式, 按下 Run Button, Memo1 會取得到 stdout
Active Connections

  Proto  Local Address          Foreign Address        State
  TCP    0.0.0.0:135            0.0.0.0:0              LISTENING
  TCP    ...
張貼者： 於 沒有留言:
標籤：

Delphi JEDI 取得 Windows Service Description

需先安裝 JEDI VCL for Delphi

uses
  JclSvcCtrl;

在 Form 中放入 TMemo 顯示訊息
加入 Form1 OnCreate 事件

procedure TForm1.FormCreate(Sender: TObject);
var
  SCManager: TJclSCManager;
  I: Integer;
  Service: TJclNtService;
begin
  Memo1.Clear;
  Memo1.WordWrap := False;
  Memo1.ScrollBars := ssBoth;
  SCManager := TJclSCManager.Create;
  try
    SCManager.Refresh(True);
    for I := 0 to SCManager.ServiceCount -1 do
    begin
      Service := SCManager.Services[I];
      Memo1.Lines.Values[Service.ServiceName] := Service.Description;
    end;
  finally
    SCManager.Free;
  end;
end;

{
AFD=AFD 網路支援環境
alerter=通知選取的使用者及電腦系統管理警示。...
ALG=提供網際網路連線共用和 Windows 防火牆的第三...
...
}
張貼者： 於 沒有留言:
標籤：

Delphi JEDI SingleInstance (單一執行程式) 


在 Menu 中選 View -> Units... [Ctrl + F12]
選擇 Project1
uses JclAppInst
加入 JclAppInstances.CheckSingleInstance;
Project1 內容如下

program Project1;

uses
  JclAppInst,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  JclAppInstances.CheckSingleInstance;
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

編譯，執行多次程式 Project1.exe
就只會有一個實體程式在執行中
張貼者： 於 沒有留言:
標籤：

Delphi JEDI Mouse Gesture 滑鼠手勢 


需先安裝 JEDI VCL for Delphi

在 Form 中
放入 TMemo 顯示訊息
放入 Jv Non-Visual -> TJvMouseGestureHook
加入 JvMouseGestureHook1.OnouseGestureCustomInterpretation 事件

procedure TForm1.JvMouseGestureHook1MouseGestureCustomInterpretation(
  Sender: TObject; const AGesture: String);
begin
  Memo1.Lines.Add(AGesture);
end;

加入 Form1 OnCreate 事件

procedure TForm1.FormCreate(Sender: TObject);
begin
  JvMouseGestureHook1.Active := True;
end;

執行程式，即可用滑鼠右鍵拖曳畫出方向
上 U
下 D
左 L
右 R
左下 1
右下 3
左上 7
右上 9
張貼者： 於 沒有留言:
標籤：

Delphi JEDI TJvLogFile 


需先安裝 JEDI VCL for Delphi
在 Form 中
放入 Jv Non-Visual -> TJvLogFile

  FileName = 'c:\log.txt'
  AutoSave = True
  SizeLimit = 1048576 //1M

放入 TTimer 元件，並加入 Timer1 OnTimer 事件

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  JvLogFile1.Add(DateTimeToStr(Now), 'Now', DateTimeToStr(Now));
end;

執行程式後，可用文字編輯器開啟 Log File 'c:\log.txt'
張貼者： 於 沒有留言:
標籤：

Delphi JEDI Validate 


需先安裝 JEDI VCL for Delphi
在 Form 中
放入 TMemo 顯示訊息
放入 TEdit 作為驗證資料輸入欄
放入 TButton 執行驗證

放入 Jv Validators -> TJvValidationSummary
放入 Jv Validators -> TJvErrorIndicator
放入 Jv Validators -> TJvValidators

修改 JvValidators1 屬性 
    ValidationSummary = JvValidationSummary1
    ErrorIndicator = JvErrorIndicator1

用滑鼠雙擊 JvValidators1 元件會顯示 JvValidator Item Editor...
或是在JvValidators1 元件上用滑鼠右鍵選擇 JvValidator Item Editor...
    新增一個 Required Field Validator
    修改 JvRequiredFieldValidator1 屬性
      ControlToValidate = Edit1
      PropertyToValidate = 'Text'
      ErrorMessage = 'Not Empty'


加入 Form1 OnCreate 事件
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
  Edit1.Clear;
end;

加入 Button1 onclick 事件
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  if not JvValidators1.Validate then begin
    Memo1.Lines := JvValidationSummary1.Summaries;
  end;
end;

執行程式，按下 Button1 作驗證
張貼者： 於 沒有留言:
標籤：
訂閱： 文章 (Atom)

網誌存檔