Delphi 中GetLogicalDriveStrings 讀取磁碟代號列表

procedure TForm1.FormCreate(Sender: TObject);

var

  buf:array [0..MAX_PATH-1] of char;

  m_Result:Integer;

  i:Integer;

  str_temp:string;

begin

  m_Result:=GetLogicalDriveStrings(MAX_PATH,buf);

  for i:=0 to (m_Result div 4)-1 do

  begin

    str_temp:=string(buf[i*4]+buf[i*4+1]+buf[i*4+2]);

    ListBox1.Items.Add(str_temp);

  end;

 end;

轉貼至: https://www.codenong.com/cs105404755/

QuickReportLib.pas 記錄

QuickReport 群組頁數/群組合計頁數 

function PageCount(AReport:TQuickRep):Integer;

function PageNumber(AReport:TQuickRep):Integer;

function GroupCount(AReport:TQuickRep; AExpression:String):Integer;

function GroupNumber(AReport:TQuickRep; AExpression:String):Integer;

function GroupPageCount(AReport:TQuickRep; AExpression:String):Integer;

function GroupPageNumber(AReport:TQuickRep; AExpression:String):Integer;

QuickRep1.Prepare;

QuickRep1.PreviewModule;

TRegistry 操作

Uses Registry;

//取得RootKey下的節點

procedure TForm1.Button1Click(Sender: TObject);

var reg: TRegistry;

begin

  reg := TRegistry.Create;

  reg.RootKey := HKEY_LOCAL_MACHINE;

  reg.OpenKey('', False);

  reg.GetKeyNames(memo1.Lines); //取得RootKey下的節點

  reg.CloseKey;

  FreeandNil(reg);

end;

 

//取得節點內的設定

procedure TForm1.Button1Click(Sender: TObject);

var reg: TRegistry;

begin

  reg := TRegistry.Create;

  reg.RootKey := HKEY_LOCAL_MACHINE;

  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);

  reg.GetValueNames(memo1.Lines); //取得節點內的設定

  reg.CloseKey;

  FreeandNil(reg);

end;

//取值

procedure TForm1.Button2Click(Sender: TObject);

var reg: TRegistry;

  sValue:Variant;

  sName:String;

begin

  reg := TRegistry.Create;

  reg.RootKey := HKEY_LOCAL_MACHINE;

  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);   //

  sName := 'TypeGuessRows';

  if reg.ValueExists(sName) then

  begin

    //取節點內的設定值, 必須與設定值的資料型態相同

    if reg.GetDataType(sName)=rdInteger then

      sValue := reg.ReadInteger(sName)

    else if reg.GetDataType(sName)=rdString then

      sValue := reg.ReadString(sName);

  end;

  memo1.text := VarToStr(sValue);

  reg.CloseKey;

  FreeandNil(reg);

end;

//設定值

procedure TForm1.Button3Click(Sender: TObject);

var reg: TRegistry;

  sValue:Variant;

  sName:String;

begin

  reg := TRegistry.Create;

  reg.RootKey := HKEY_LOCAL_MACHINE;

  reg.OpenKey('SOFTWARE\Microsoft\Jet\4.0\Engines\Excel', False);

  sName := 'TypeGuessRows';

  if reg.ValueExists(sName) then

  begin

    //取節點內的設定值, 必須與設定值的資料型態相同

    if reg.GetDataType(sName)=rdInteger then

      reg.WriteInteger(sName, 0)

    else if reg.GetDataType(sName)=rdString then

      reg.WriteInteger(sName, 0)

  end;

  reg.CloseKey;

  FreeandNil(reg);

end;

Windows 縮放與版面配置 (Scale and layout)，參數值存放位置

Client:TSocketConnection和Server:Scktsrvr關系----壓縮數據傳輸

Client:TSocketConnection和Server:Scktsrvr關系----壓縮數據傳輸

一直用SocketConnection和服務端的傳輸數據在三層數據庫中，從來沒有注意到它們之間的數據傳輸，只是想著，管它了，網絡的事，前段時間在Delphi中的Demos中發現DemosMidasIntrcpt.dpr例子，呵呵，再看了半天的VCL發現可以將Client端發送的給Server的數據，和Server發送給Client的數據是可以進行壓縮的。呵呵，不敢藏私，Share給大家。

1:

准備工作,先delphi光盤中的infoextraszlibzlib.pas進行編繹，然後copy 到lib路徑中，因為要壓縮數據，必須要有壓縮功能，這個delphi已經自帶，它是基於流的方式對接口IDataBlock(TDataBlock實現，其實就是對TMemoryStream的操作)數據進行壓縮和解壓的。做了這個後，才能進行下面的工作。

2:

Open DemosMidasIntrcptIntrcpt.dpr 

complier....(如沒有做第一步，嘿嘿...)

生成Intrcpt.dll 

將Intrcpt.dll copy to System directory,或者你的程序下面。

注冊它：regsrvr32 Intrcpt.dll (為什麼，這個嘛...)

記住Intrcpt.dpr的那個GUID,你也可以自己重新生成一個(按Shift+Ctrl+G)

3:

Server: 

Open scktsrvr.exe，相信各位都很熟悉那界面，端口(TListbox)，Thread Cache Size(TEdit), GUID(TEdit),好，我們要做的事，就是將注冊的Intrcpt.dll那個GUID填到這個GUID(TEdit)框框中，

只需填自己程序的的那個端口的GUID啊，別亂填，如果有別人用這個程序，出了什麼，別找我。OK,Apply.

Client:

你寫的程序中肯定有TSocketConnection,它有個屬性InterceptGUID: string;好了，將Intrcpt.dll的GUID填上去，它是跟Server中的一樣的。OK.還有別忘了，Regsrvr32 intrcpt.dll 在你的客戶端。不然，程序雖不會raise,但是Server傳過來的數據是壓縮的....  

好了，呵呵。就這些了。3步驟，很清楚吧(不會吧，還不懂，倒)

原理

scktsrvr.exe其實是一堆TServerSocket,一個端口代表了一個TServerSocket,每個TServerSocket是基於多線程方式與客戶端進行數據交換。它寫了個TServerClientThread(在服務端中的客戶端)的擴展

,多加了對客戶端數據接收的管理解析，還有ActivityDateTime,GUID，一般不管它。但是我們用到的壓縮只是跟這個GUID有關，其它費話少說。

Server接受一個Client連接,則加一個TServerClientThread到本地中，用來監控Client Read 和Close事件，所以Server中的scktsrvr中我們只要了解了TServerClientThread動作方式就行了。

(

題外話：Server Socket中有客戶端連接後，記錄ClientSocket.Handle,並且將根據這個Handle產生一個TServerClientWinSocket對象加入到Connections(TList)對象中,當任何對這個Client的動作也就是說Server 發送和接收數據都是根據這個Client Handle來進行的，相應的ServerSocket中的Connections中的ClientSocket也發生相應的變化。

)

有兩個類跟這個TServerClientThread(實現ISendDataBlock接口)有關

1: TDataBlockInterpreter(對發送過來的數據進行解析InterpretData(Data: IDataBlock))

  解析數據（水平有限，對它真是還是一知半解，有錯請指出)

    接口類IDataBlock,由TDataBlock通過TMemoryStream的讀寫來實現，其中Signature是其主要標識，說明這個IDataBlock的數據類型    ，TDataBlockInterpreter根據Signature來對應進行相應的調用，  如：

    Client端連接後，在Server要運行應用服務器(Application Server),

    Client端需要得到ServerName 列表,

    Client端得到Server 的DataBroker的列表，

    Client端斷開連接後，Server要Close應用服務器(Application Server),

    Client和Server的數據交換，也是由它來解析。

所以這個IDataBlock的數據很重要，而我們的壓縮和解壓就是針對於它，但是TDataBlockInterpreter是得到Data才對它解析，因而我們要在Send 和Recv 之前對它解壓和壓縮。這個任務在TSocketTransport身上。    

2: TSocketTransport;(數據進行發送和接收, 實現ITransport接口)

  Server端:

    在Server端,TSocketTransport其實就是一個用來管理對ClientSocket實例，它將ClientSocket.Handle生成一個對象後，ClientSocket發送和接收過來的Data，在發送Data之前,它將調用InterceptOutgoing(Data: IDataBlock)函數，這個函數的功能是:

如果InterceptGUID <> ，那麼它將根據這個GUID生成一個COM(Obj)對象，Obj.DataOut(Data: IDataBlock),也就是我們注冊的那個壓縮的DLL中的那個壓縮函數，將壓縮過後的Data再發送出去。這就完成compress and send Data.(我試過那個壓縮功能，壓縮比大概是1/9,像zip壓縮比差不多).

由客戶端傳過來的數據調用InterceptIncoming(Data: IDataBlock)函數，這就不多說了，Data := 解壓後的Data.  壓縮和解壓過後的Data交由TDataBlockInterpreter去解析，完成一次數據交換。  

  Client端：

    說完Server端，客戶端的道理也是差不多的。唯一不同的是Server端中不調用ITransport.SetConnected()方法，因為它是根據ClientSocket.Handle生成的對象，也就是它是已經連接的對象,而Client端的TSocktConnection調用Connected := True時，其實就是調用ITransport.SetConnect將一個ClientSocket連接到Server端中的TServerSocket中，然後TServerSocket根據這個ClientSocket.Handle生成了一個TServerClientThread對象保存在本地中，開始對這個ClientSocket的監控(FD_Read, FD_Close消息事件).

注：

  IDataBlock由TDataBlock實現，主要是管理TMemoryStream來存放數據

  ITransport由TSocketTransport實現，主要是用TClientSocket來連接TServerSocket,並和它進行交換數據。

  ISendDataBlock在Scktsrvr.exe中由TServerClientThread實現，通過TSocketTransport來發送數據.

轉貼至 http://www.aspphp.online/bianchen/gengduo/delphi/201701/221405.html

Display Menu Item Hints

  F_HintWindow:THintWindow;

  ..

  Private

    procedure WMMenuSelect(var Msg: TWMMenuSelect) ; message WM_MENUSELECT; 

  ..

  ..

procedure TForm1.WMMenuSelect(var Msg: TWMMenuSelect); 

var miSelectItem:TMenuItem;

  hSubMenu : HMENU;

begin

  if Msg.MenuFlag and MF_POPUP = MF_POPUP then

  begin

    hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem) ;

    miSelectItem := Self.Menu.FindItem(hSubMenu, fkHandle) ;

  end

  else

  begin

    miSelectItem := Self.Menu.FindItem(Msg.IDItem, fkCommand) ;

  end;

  //

  if not Assigned(miSelectItem) then

    Exit;

  //

  if True then

  begin

    pr_Show_HintWindow('Display Menu Item Hints');

  end

  else

  begin

    pr_Close_HintWindow;

  end;

end;

procedure TForm1.pr_Show_HintWindow(AText:String);

var pPoint:TPoint;

  iHeight, iWidth:Integer;

begin

  if not Assigned(F_HintWindow) then

    F_HintWindow := THintWindow.Create(Self);

  //

  pPoint := ClientToScreen(Mouse.CursorPos);

  iHeight := Canvas.TextHeight(AText);

  iWidth := Canvas.TextWidth(AText);

  F_HintWindow.ActivateHint(Rect(pPoint.X, pPoint.Y,pPoint.X+iWidth, pPoint.Y+iHeight), AText);

end;

procedure TForm1.pr_Close_HintWindow;

begin

  if Assigned(F_HintWindow) then

    F_HintWindow.ReleaseHandle;

end;

參考

  https://www.thoughtco.com/how-to-display-menu-item-hints-1058397

Delphi 執行檔，程式碼執行無法繼續，因為找不到Borlndmm.dll。...

Delphi 獨立執行檔(Exe)，啟動後出現錯誤訊息

"程式碼執行無法繼續，因為找不到borlndmm.dll。重新安裝程式或許可以修正此問題。"

與 uese ShareMem有關

在字串中重複的出現次數

function fn_StrOccurrences(const ASubStr, AText:String):Integer; //在字串中重複的出現次數

var iOffset:Integer;

begin

  Result := 0;

  iOffset := PosEx(ASubStr, AText, 1);

  while iOffset<>0 do

  begin

    Inc(Result);

    iOffset := PosEx(ASubStr, AText, iOffset + Length(ASubStr));

  end;

end;

轉貼至:http://grandruru.blogspot.com/2016/08/blog-post.html

...import an Excel Table to a TStringgrid?

...import an Excel Table to a TStringgrid?

Autor: Thomas Stutz

uses

  ComObj;

function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;

const

  xlCellTypeLastCell = $0000000B;

var

  XLApp, Sheet: OLEVariant;

  RangeMatrix: Variant;

  x, y, k, r: Integer;

begin

  Result := False;

  // Create Excel-OLE Object

  XLApp := CreateOleObject('Excel.Application');

  try

    // Hide Excel

    XLApp.Visible := False;

    // Open the Workbook

    XLApp.Workbooks.Open(AXLSFile);

    // Sheet := XLApp.Workbooks[1].WorkSheets[1];

    Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

    // In order to know the dimension of the WorkSheet, i.e the number of rows

    // and the number of columns, we activate the last non-empty cell of it

    Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

    // Get the value of the last row

    x := XLApp.ActiveCell.Row;

    // Get the value of the last column

    y := XLApp.ActiveCell.Column;

    // Set Stringgrid's row &col dimensions.

    AGrid.RowCount := x;

    AGrid.ColCount := y;

    // Assign the Variant associated with the WorkSheet to the Delphi Variant

    RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;

    //  Define the loop for filling in the TStringGrid

    k := 1;

    repeat

      for r := 1 to y do

        AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];

      Inc(k, 1);

      AGrid.RowCount := k + 1;

    until k > x;

    // Unassign the Delphi Variant Matrix

    RangeMatrix := Unassigned;

  finally

    // Quit Excel

    if not VarIsEmpty(XLApp) then

    begin

      // XLApp.DisplayAlerts := False;

      XLApp.Quit;

      XLAPP := Unassigned;

      Sheet := Unassigned;

      Result := True;

    end;

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  if Xls_To_StringGrid(StringGrid1, 'C:\Table1.xls') then

    ShowMessage('Table has been exported!');

end;

轉貼至:https://www.swissdelphicenter.ch/en/showcode.php?id=1728

Table 分組後取最大的資料列

1.

  Select A.* 

  From [Table1] as A

  Inner Join (

              Select [Field01], Max([Score]) Score

              From [Table1]

              Group By [Field01) as B on A.[Field01]=B.[Field01] and A.[Score]=B.[Score] 

  Order By A.[Field01]

2.

  Select *

  From (

    Select ROW_NUMBER() OVER(PARTITION BY [Field01] ORDER BY [Score] DESC) as rowid, *

    FROM [Table1]

  )

  Where rowid=1

C# PadLeft / PadRight 字串補指定字元

string str="A";
str.PadLift(3,'0'); --> 00A 左邊補指定字元
str.PadRight(3, '0'); --> A00 右邊補指定字元

C# InputBox 輸入視窗

using System.Windows.Forms;
using System.Drawing;

public static DialogResult InputBox(string title, string promptText, ref string value)
{
  Form form = new Form();
  Label label = new Label();
  TextBox textBox = new TextBox();
  Button buttonOk = new Button();
  Button buttonCancel = new Button();

  form.Text = title;
  label.Text = promptText;
  textBox.Text = value;

  buttonOk.Text = "OK";
  buttonCancel.Text = "Cancel";
  buttonOk.DialogResult = DialogResult.OK;
  buttonCancel.DialogResult = DialogResult.Cancel;

  label.SetBounds(9, 20, 372, 13);
  textBox.SetBounds(12, 36, 372, 20);
  buttonOk.SetBounds(228, 72, 75, 23);
  buttonCancel.SetBounds(309, 72, 75, 23);

  label.AutoSize = true;
  textBox.Anchor = textBox.Anchor | AnchorStyles.Right;
  buttonOk.Anchor = AnchorStyles.Bottom | AnchorStyles.Right;
  buttonCancel.Anchor = AnchorStyles.Bottom | AnchorStyles.Right;

  form.ClientSize = new Size(396, 107);
  form.Controls.AddRange(new Control[] { label, textBox, buttonOk, buttonCancel });
  form.ClientSize = new Size(Math.Max(300, label.Right + 10), form.ClientSize.Height);
  form.FormBorderStyle = FormBorderStyle.FixedDialog;
  form.StartPosition = FormStartPosition.CenterScreen;
  form.MinimizeBox = false;
  form.MaximizeBox = false;
  form.AcceptButton = buttonOk;
  form.CancelButton = buttonCancel;

  DialogResult dialogResult = form.ShowDialog();
  value = textBox.Text;
  return dialogResult;
}




 Ex:

string value = "Document 1";

if (Tmp.InputBox("New document", "New document name:", ref value) == DialogResult.OK)
{
  myDocument.Name = value;
}

轉貼至 https://dotblogs.com.tw/aquarius6913/2014/09/03/146444

C# MessageBox 常用語法

  MessageBox.Show("Hello World");

  DialogResult result;
  result = MessageBox.Show("Are you OK?", "Question",
    MessageBoxButtons.YesNo,
    MessageBoxIcon.Question);
  if (result = DialogResult.Yes)
  {
    ...
  }

C# DevExpress PopupMenu

                    Point pointPos = new Point();

                    pointPos.X = button1.Left;

                    pointPos.Y = button1.Left + button1.Height;

                    pointPos = button1.PointToScreen(pointPos);

                    popupMenu1.ShowPopup(pointPos);

Which is the best way to load a string (HTML code) in TWebBrowser?

procedure THTMLEdit.EditText(CONST HTMLCode: string);
var
  Doc: Variant;
begin
  if NOT Assigned(wbBrowser.Document) then
    wbBrowser.Navigate('about:blank');

  Doc := wbBrowser.Document;
  Doc.Clear;
  Doc.Write(HTMLCode);
  Doc.Close;
end;


https://stackoverflow.com/questions/39773033/which-is-the-best-way-to-load-a-string-html-code-in-twebbrowser

URLDownloadToFile - some pages is not download

It seems that Win7 does some of the work for us - that is to say, I just tried the code in a virtual machine with XP and VS2005 - I got the same problem, i.e error (from the watch window) - "hRes 0x800401e4 Invalid syntax HRESULT"

Earlier in the evening I had read that you need to make sure COM is initialized for the thread. I disregarded this and plowed on - this was fine when I used Win7 and Vs2010.

Anyway, the fix was to use CoInitialize(NULL); before the call to URLDownloadToFile - after this change, hRes holds S_OK afterwards. :)

Listing as tested with VS2005 in XP
Hide   Copy Code
#include "stdafx.h"
#include <windows.h>
#include <urlmon.h>

int main()
{
CoInitialize(NULL);
HRESULT hRes;
hRes = URLDownloadToFile(NULL, L"http://www.google.com/", L"google.com.file", 0, NULL);

return 0;
}

Posted 12-Aug-12 9:03am
enhzflep


https://www.codeproject.com/Questions/439137/URLDownloadToFile-some-pages-is-not-download

DELPHI TDownLoadURL下载网络文件

unit Unit1;

interface

uses
  //引用   Vcl.ExtActns
  Vcl.ExtActns,
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Edit;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    ProgressBar1: TProgressBar;
    Edit1: TEdit;
    GroupBox2: TGroupBox;
    Edit3: TEdit;
    Edit4: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure URL_OnDownloadProgress(Sender: TDownLoadURL;
    Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
    StatusText: String; var Cancel: Boolean);
  public
    { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.fmx}

var

  DownLoadURL1:TDownLoadURL;


//url=网络文件  'http://helloroman.oicp.net:8000/test.rar';
//Filename=保存到本地文件 'D:\Administrator\Desktop\123.rar';

function DownLoadFile(url,Filename:string):boolean;
var
  DownLoadURL1:TDownLoadURL;
begin
  try
    DownLoadURL1:=TDownLoadURL.Create(Form1);
    DownLoadURL1.URL:= url;
    DownLoadURL1.Filename:= Filename;
    DownLoadURL1.OnDownloadProgress:=Form1.URL_OnDownloadProgress;
    DownLoadURL1.ExecuteTarget(nil);
    DownLoadURL1.Free;
    Result:=true;
  except
    Result:=false;
  end;
end;


procedure DownLoadThread;
begin
  Form1.label3.Text:='0 kb / 0 kb';
  if DirectoryExists(ExtractFilePath(Form1.edit4.text)) then
  begin
    if not DownLoadFile(Form1.edit3.text,Form1.edit4.text) then
      Form1.GroupBox1.Text:='下载失败'
    else
      Form1.GroupBox1.Text:='下载完毕';
  end
  else
     SHowMessage(Form1.edit4.text + '不存在！');
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(DownLoadThread).Start;
end;

function BytesToStr(iBytes: Integer): String;
var
  iKb: Integer;
begin
  iKb := Round(iBytes / 1024);
  if iKb > 1000 then
    Result := Format('%.2f MB', [iKb / 1024])
  else
    Result := Format('%d KB', [iKb]);
end;

// 获取网络文件名
function GetUrlFileName(url:string):string;
var
 str:string;
begin
 url:=StringReplace(StrRScan(PChar(url),'/'), '/', '',[rfReplaceAll]);
 if Pos('=',url) > 0 then
    url:=StringReplace(StrRScan(PChar(url),'='), '=', '',[rfReplaceAll]);
 Result:=url;
end;

procedure TForm1.URL_OnDownloadProgress(Sender: TDownLoadURL;
  Progress, ProgressMax: Cardinal; StatusCode: TURLDownloadStatus;
  StatusText: String; var Cancel: Boolean);
begin
  ProgressBar1.Max := ProgressMax div 100;
  ProgressBar1.Value := Progress div 100;

  Caption := StatusText;

  case StatusCode of
    dsFindingResource:GroupBox1.Text:='查找资源...';
    dsConnecting:GroupBox1.Text:='连接中...';
    dsRedirecting:GroupBox1.Text:='';
    dsBeginDownloadData:GroupBox1.Text:='准备下载文件...';
    dsDownloadingData:GroupBox1.Text:='下载中...';
  end;


  Edit1.Text:= Format('文件名：%s',[GetUrlFileName(Edit3.Text)]);
  label3.Text := Format('%s / %s', [BytesToStr(Progress),BytesToStr(ProgressMax)]);
end;

end.



http://www.cnblogs.com/xe2011/p/3719454.html

How to download a file from the Internet

uses
  URLMon, ShellApi;

function fn_DownloadFile(ASourceFile, ADestFile: String): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(ASourceFile), PChar(ADestFile), 0, nil) = 0;
  except
    Result := False;
  end;
end;


URLDownloadToFile function

https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/platform-apis/ms775123(v=vs.85)?redirectedfrom=MSDN

遞迴 SQL With...

  with [recursive] as(
    ----------------------
    --資料來源 begin
    ----------------------
    Select field1 , field2
    From Table a
    Where field1 = 1
    --------------------
    --資料來源 end
    -------------------
    Union All
    Select b.field1, b.field2
    From Table b
    Join [recursive] on b.field2 = [recursive].fied01
  )
  select * from [recursive]

Unable to write to ...\__recovery.ini