mysql笔记(5)--集合函数,时间日期函数,字符串匹配函数

mysql中的集合函数有:count(),sum(),avg(),min(),max(),时间和日期函数等。

1.   1) select count(*) from xindi where phone=123456;//计算表xindi中phone=123456的个数 或者 select count(phone)from xindi where phone=123456;

   2)select count(phone)from xindi; //phone 列的数目

   3)select count(distinct phone)from xindi;//有多少个不同种类的电话

    4)如果种类phone出现了不止一次,它将只被计算一次。关键字DISTINCT 决定了只有互不相同的值才被计算。

通常,当你使用COUNT()时,字段中的空值将被忽略,不算入内。

另外,COUNT()函数通常和GROUP BY子句配合使用,例如可以这样返回每种phone的数目:

select phone, count(phone) from xindi group by phone;

5)select avg(phone)from xindi; // 在计算平均时,忽略空值,phone共四个值,两个空值,除以时只除2.

select name,avg(phone) from xindi group by(name); // 计算每个名字的phone 的平均值

6)select sum(phone) from xindi;

   Select name, sum(phone) group by (name);

7)极值:

Select min(phone)from xindi;

Select name,min(phone)from xindi;//这是错误的sql语句,因为集合函数不能和非分组的列混合使用,上述name未分组。所以应用下面的语句:

select name,min(phone) from xindi group by name;

2.操作时间和日期:日期和时间类型:DATETIME、DATE、TIMESTAMP、TIME和YEAR这5种类型的每一个都有合法值的一个范围,而“零”当你指定确实不合法的值时被使用。

a. 当前日期 select curdate();select curdate()+0;

   当前时间 select curtime();select curtime()+0;

b. 自动记录数据的改变时间:

     TIMESTAMP类型提供一种类型,TIMESTAMP值可以从1970的某时的开始一直到2037年,精度为一秒,其值作为数字显示。你可以使用它自动地用当前的日期和时间标记INSERT或UPDATE的操作。

mysql> CREATE TABLE student

-> (

-> id int,

-> name char(16),

-> time timestamp

-> );

向表中插入记录,可以查看效果:

Insert student values(1,’jim’,null);

select *from student;

update student set name=’lan’where id=1;

select*from student; //time的值会改变

有时希望不更改任何值,也能达到修改timestamp列的值,这时设置该列的值为null,mysql就可以自动更新timestamp的值:

Update student set time=null where id=1;

Select*from student ;//这时timestamp的值已改变

如果,当你创建一个行时,你想要一个TIMESTAMP被设置到当前的日期和时间,但在以后无论何时行被更新时都不改变,可以这样

Update student set name=’yun’,time=time where id=1;

Select *from student where id=1;

TIMESTAMP的存储需求是4字节,而DATETIME列的存储需求是8字节。

c.返回时间和日期

mysql> SELECT * FROM weblog WHERE entrydate>="2001-02-08" AND entrydate<"2001-02-09" ;

或者 mysql> SELECT * FROM weblog WHERE entrydate LIKE '2001-02-08%' ;

注:LIKE运算符和模式匹配,是通过比较串值进行的,因此必须使用标准的时间书写格式,YYYY-MM-DD HH-MM-SS

d. 比较日期和时间:

mysql> SELECT FROM_DAYS(729669); -> '1997-10-07'
 
 TO_DAYS(date) 给出一个日期 date,返回一个天数(从 0 年开始的天数): mysql> SELECT TO_DAYS(950501); -> 728779 mysql> SELECT TO_DAYS('1997-10-07'); -> 729669
TO_DAYS()  无意于使用先于格里高里历法(即现行的阳历)(1582)出现的值,因为它不考虑当历法改变时所遗失的天数。
 
FROM_DAYS(N) 给出一个天数 N,返回一个 DATE 值:
返回2个时间相差的天数

select to_days(now())-to_days('20100510');


3. 字符串模式匹配:

SQL的模式匹配允许你使用 “_”匹配任何单个字符,而“%”匹配任意数目字符(包括零个字符)。在MySQL中,SQL的模式缺省是忽略大小写的。

select*from xindi where name like "l%i";

select*from xindi where name like " %i";

select*from xindi where name like "l% ";

select*from xindi where name like "l___";//l后面有三个字符的

mysql> SELECT * FROM pet WHERE name REGEXP "^[bB]";

mysql> SELECT * FROM pet WHERE name REGEXP "fy$";

mysql> SELECT * FROM pet WHERE name REGEXP "[wW]";

mysql> SELECT * FROM pet WHERE name REGEXP "^.....$";//重复5次(有5个字符)

mysql> SELECT * FROM pet WHERE name REGEXP "^.{5}$"; //重复5次(有5个字符)

Posted in 数据库 at March 1, 2012. by 傻猫 .    Views: 4028    No Comments

SQL自定义函数实现特殊功能

由于SQL查询语句中不能直接使用存储过程,所以只能使用自定义函数来实现了。

实例如下:我有一个用户信息表,还有一个电话列表

要求:查询用户信息的时候,把电话列表拼接起来作为一个字段返回。

表内容.jpg

自定义一个函数,函数里使用了游标来进行循环获取电话号码,并接进完成,函数返回拼接好的电话列表。

(红色部分是返回值的长度,必须定义。之前我没有定义长度,始终只返回一个字符,相当悲剧。)

ALTER      FUNCTION GetDHLB(@user_id varchar(20))
RETURNS varchar(1000) AS 
BEGIN

 DECLARE   @phonenumberlist nvarchar(20)
 DECLARE   @phonenumber  nvarchar(20)
  declare @flag int

 DECLARE cursor_dhlb CURSOR FOR

  ( select tel from mytel where main_id = @user_id)

 open cursor_dhlb

 FETCH NEXT FROM cursor_dhlb INTO @phonenumber

 set @flag = 0

 WHILE (@@fetch_status = 0)
 BEGIN
  

  if @flag = 0
  begin
          SET @phonenumberlist  = @phonenumber
  end
  else
  begin
          SET @phonenumberlist  = @phonenumberlist +'/'+ @phonenumber
  end
     
  set @flag = @flag + 1


  FETCH NEXT FROM cursor_dhlb INTO @phonenumber
 END

 close cursor_dhlb
 Deallocate cursor_dhlb


 return @phonenumberlist

END

操作结果.jpg

Posted in 软件开发,Web开发 at September 7, 2011. by 傻猫 .    Views: 4222    No Comments

Delphi常用的函数库

 Delphi常用的函数库,引用作者的话“今天在整理以前写过的代码,发现有些函数还是挺实用的,决定将其贴到Blog上,与众多好友一起分享。”

源文地址:http://blog.csdn.net/chris_mao/archive/2007/11/01/1862017.aspx

{*******************************************************************************
* 模块名称: 公用函数库
* 编写人员: Chris Mao
* 编写日期: 2004.10.30
******************************************************************************}
unit JrCommon;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShellAPI, CommDlg, MMSystem, StdCtrls, Registry, JrConsts, Winsock;

//------------------------------------------------------------------------------
//窗体类函数
//------------------------------------------------------------------------------
function FindFormClass(FormClassName: PChar): TFormClass;
function HasInstance(FormClassName: PChar): Boolean;

//------------------------------------------------------------------------------
//公用对话框函数
//------------------------------------------------------------------------------
procedure InfoDlg(const Msg: String; ACaption: String = SInformation);
{ 信息对话框 }

procedure ErrorDlg(const Msg: String; ACaption: String = SError);
{ 错误对话框 }

procedure WarningDlg(const Msg: String; ACaption: String = SWarning);
{ 警告对话框 }

function QueryDlg(const Msg: String; ACaption: String = SQuery): Boolean;
{ 确认对话框 }

function QueryNoDlg(const Msg: string; ACaption: string = SQuery): Boolean;
{ 确认对话框,默认按钮为"否" }

function JrInputQuery(const ACaption, APrompt: String; var Value: string): Boolean;
{ 输入对话框 }

function JrInputBox(const ACaption, APrompt, ADefault: string): String;
{ 输入对话框 }

//------------------------------------------------------------------------------
//扩展文件目录操作函数
//------------------------------------------------------------------------------

procedure RunFile(const FileName: String; Handle: THandle = 0; Param: string = '');
{ 运行一个文件 }

function AppPath: string;
{ 应用程序路径 }

function GetProgramFilesDir: string;
{ 取Program Files目录 }

function GetWindowsDir: string;
{ 取Windows目录}

function GetWindowsTempPath: string;
{ 取临时文件路径 }

function GetSystemDir: string;
{ 取系统目录 }

//------------------------------------------------------------------------------
//扩展字符串操作函数
//------------------------------------------------------------------------------

function InStr(const sShort: string; const sLong: string): Boolean;
{ 判断s1是否包含在s2中 }

function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
{ 带分隔符的整数-字符转换 }

function ByteToBin(Value: Byte): string;
{ 字节转二进制串 }

function StrRight(Str: string; Len: Integer): string;
{ 返回字符串右边的字符 }

function StrLeft(Str: string; Len: Integer): string;
{ 返回字符串左边的字符 }

function Spc(Len: Integer): string;
{ 返回空格串 }

procedure SwapStr(var s1, s2: string);
{ 交换字串 }

//------------------------------------------------------------------------------
// 扩展日期时间操作函数
//------------------------------------------------------------------------------

function GetYear(Date: TDate): Word;
{ 取日期年份分量 }

function GetMonth(Date: TDate): Word;
{ 取日期月份分量 }

function GetDay(Date: TDate): Word;
{ 取日期天数分量 }

function GetHour(Time: TTime): Word;
{ 取时间小时分量 }

function GetMinute(Time: TTime): Word;
{ 取时间分钟分量 }

function GetSecond(Time: TTime): Word;
{ 取时间秒分量 }

function GetMSecond(Time: TTime): Word;
{ 取时间毫秒分量 }

//------------------------------------------------------------------------------
// 位操作函数
//------------------------------------------------------------------------------
type
TByteBit = 0..7; // Byte类型位数范围
TWordBit = 0..15; // Word类型位数范围
TDWordBit = 0..31; // DWord类型位数范围

procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload;
{ 设置二进制位 }

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload;
{ 设置二进制位 }

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload;
{ 设置二进制位 }

function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload;
{ 取二进制位 }

function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload;
{ 取二进制位 }

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload;
{ 取二进制位 }

//------------------------------------------------------------------------------
// 系统功能函数
//------------------------------------------------------------------------------

procedure ChangeFocus(Handle: THandle; Forword: Boolean = False);
{ 改变焦点 }

procedure MoveMouseIntoControl(AWinControl: TControl);
{ 移动鼠标到控件 }

procedure AddComboBoxTextToItems(ComboBox: TComboBox; MaxItemsCount: Integer = 10);
{ 将 ComboBox 的文本内容增加到下拉列表中 }

function DynamicResolution(x, y: WORD): Boolean;
{ 动态设置分辨率 }

procedure StayOnTop(Handle: HWND; OnTop: Boolean);
{ 窗口最上方显示 }

procedure SetHidden(Hide: Boolean);
{ 设置程序是否出现在任务栏 }

procedure SetTaskBarVisible(Visible: Boolean);
{ 设置任务栏是否可见 }

procedure SetDesktopVisible(Visible: Boolean);
{ 设置桌面是否可见 }

function GetWorkRect: TRect;
{ 取桌面区域 }

procedure BeginWait;
{ 显示等待光标 }

procedure EndWait;
{ 结束等待光标 }

function CheckWindows9598: Boolean;
{ 检测是否Win95/98平台 }

function GetOSString: string;
{ 返回操作系统标识串 }

function GetComputeNameStr : string;
{ 得到本机名 }

function GetLocalUserName: string;
{ 得到本机用户名 }

function GetLocalIP: String;
{ 得到本机IP地址 }

//------------------------------------------------------------------------------
// 其它过程
//------------------------------------------------------------------------------

function TrimInt(Value, Min, Max: Integer): Integer; overload;
{ 输出限制在Min..Max之间 }

function InBound(Value: Integer; Min, Max: Integer): Boolean;
{ 判断整数Value是否在Min和Max之间 }

procedure Delay(const uDelay: DWORD);
{ 延时 }

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);
{ 在Win9X下让喇叭发声 }

function GetHzPy(const AHzStr: string): string;
{ 取汉字的拼音 }

function UpperCaseMoney(const Money: Double): String;
{ 转换为大与金额 }

function SoundCardExist: Boolean;
{ 声卡是否存在 }

implementation

//------------------------------------------------------------------------------
//窗体类函数
//------------------------------------------------------------------------------

function FindFormClass(FormClassName: PChar): TFormClass;
begin
Result := TFormClass(GetClass(FormClassName));
end;

function HasInstance(FormClassName: PChar): Boolean;
var
i: integer;
begin
Result:=False;
for i := Screen.FormCount - 1 downto 0 do begin
Result := SameText(Screen.Forms[i].ClassName, FormClassName);
if Result then begin
TForm(Screen.Forms[i]).BringToFront;
Break;
end;
end;
end;

//------------------------------------------------------------------------------
//公用对话框函数
//------------------------------------------------------------------------------

procedure InfoDlg(const Msg: String; ACaption: String = SInformation);
begin
Application.MessageBox(PChar(Msg), PChar(ACaption), MB_OK + MB_ICONINFORMATION);
end;

procedure ErrorDlg(const Msg: String; ACaption: String = SError);
begin
Application.MessageBox(PChar(Msg), PChar(ACaption), MB_OK + MB_ICONERROR);
end;

procedure WarningDlg(const Msg: String; ACaption: String = SWarning);
begin
Application.MessageBox(PChar(Msg), PChar(ACaption), MB_OK + MB_ICONWARNING);
end;

function QueryDlg(const Msg: String; ACaption: String = SQuery): Boolean;
begin
Result := Application.MessageBox(PChar(Msg), PChar(ACaption),
MB_YESNO + MB_ICONQUESTION) = IDYES;
end;

function QueryNoDlg(const Msg: string; ACaption: string = SQuery): Boolean;
begin
Result := Application.MessageBox(PChar(Msg), PChar(ACaption),
MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES;
end;

function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;

function JrInputQuery(const ACaption, APrompt: String; var Value: string): Boolean;
var
Form: TForm;
Prompt: TLabel;
Edit: TEdit;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
Result := False;
Form := TForm.Create(Application);
with Form do
try
Scaled := False;
Font.Name := SDefaultFontName;
Font.Size := SDefaultFontSize;
Font.Charset := SDefaultFontCharset;
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
BorderStyle := bsDialog;
Caption := ACaption;
ClientWidth := MulDiv(180, DialogUnits.X, 4);
ClientHeight := MulDiv(63, DialogUnits.Y, 8);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
AutoSize := True;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Caption := APrompt;
end;
Edit := TEdit.Create(Form);
with Edit do
begin
Parent := Form;
Left := Prompt.Left;
Top := MulDiv(19, DialogUnits.Y, 8);
Width := MulDiv(164, DialogUnits.X, 4);
MaxLength := 255;
Text := Value;
SelectAll;
end;
ButtonTop := MulDiv(41, DialogUnits.Y, 8);
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := SMsgDlgOK;
ModalResult := mrOk;
Default := True;
SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := SMsgDlgCancel;
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
if ShowModal = mrOk then
begin
Value := Edit.Text;
Result := True;
end;
finally
Form.Free;
end;
end;

function JrInputBox(const ACaption, APrompt, ADefault: string): String;
begin
Result := ADefault;
JrInputQuery(ACaption, APrompt, Result);
end;

//------------------------------------------------------------------------------
//扩展文件目录操作函数
//------------------------------------------------------------------------------

procedure RunFile(const FileName: String; Handle: THandle = 0; Param: string = '');
begin
ShellExecute(Handle, nil, PChar(FileName), PChar(Param), nil, SW_SHOWNORMAL);
end;

function AppPath: string;
begin
Result := ExtractFilePath(Application.ExeName);
end;

const
HKLM_CURRENT_VERSION_WINDOWS = 'SoftwareMicrosoftWindowsCurrentVersion';

function RelativeKey(const Key: string): PChar;
begin
Result := PChar(Key);
if (Key <> '') and (Key[1] = '') then
Inc(Result);
end;

function RegReadStringDef(const RootKey: HKEY; const Key, Name, Def: string): string;
var
RegKey: HKEY;
Size: DWORD;
StrVal: string;
RegKind: DWORD;
begin
Result := Def;
if RegOpenKeyEx(RootKey, RelativeKey(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
begin
RegKind := 0;
Size := 0;
if RegQueryValueEx(RegKey, PChar(Name), nil, @RegKind, nil, @Size) = ERROR_SUCCESS then
if RegKind in [REG_SZ, REG_EXPAND_SZ] then
begin
SetLength(StrVal, Size);
if RegQueryValueEx(RegKey, PChar(Name), nil, @RegKind, PByte(StrVal), @Size) = ERROR_SUCCESS then
begin
SetLength(StrVal, StrLen(PChar(StrVal)));
Result := StrVal;
end;
end;
RegCloseKey(RegKey);
end;
end;

procedure StrResetLength(var S: AnsiString);
begin
SetLength(S, StrLen(PChar(S)));
end;

function GetProgramFilesDir: string;
begin
Result := RegReadStringDef(HKEY_LOCAL_MACHINE, HKLM_CURRENT_VERSION_WINDOWS, 'ProgramFilesDir', '');
end;

function GetWindowsDir: string;
var
Required: Cardinal;
begin
Result := '';
Required := GetWindowsDirectory(nil, 0);
if Required <> 0 then
begin
SetLength(Result, Required);
GetWindowsDirectory(PChar(Result), Required);
StrResetLength(Result);
end;
end;

function GetWindowsTempPath: string;
var
Required: Cardinal;
begin
Result := '';
Required := GetTempPath(0, nil);
if Required <> 0 then
begin
SetLength(Result, Required);
GetTempPath(Required, PChar(Result));
StrResetLength(Result);
end;
end;

function GetSystemDir: string;
var
Required: Cardinal;
begin
Result := '';
Required := GetSystemDirectory(nil, 0);
if Required <> 0 then
begin
SetLength(Result, Required);
GetSystemDirectory(PChar(Result), Required);
StrResetLength(Result);
end;
end;

//------------------------------------------------------------------------------
//扩展字符串操作函数
//------------------------------------------------------------------------------

function InStr(const sShort: string; const sLong: string): Boolean;
var
s1, s2: string;
begin
s1 := LowerCase(sShort);
s2 := LowerCase(sLong);
Result := Pos(s1, s2) > 0;
end;

function IntToStrSp(Value: Integer; SpLen: Integer = 3; Sp: Char = ','): string;
var
s: string;
i, j: Integer;
begin
s := IntToStr(Value);
Result := '';
j := 0;
for i := Length(s) downto 1 do
begin
Result := s[i] + Result;
Inc(j);
if ((j mod SpLen) = 0) and (i <> 1) then Result := Sp + Result;
end;
end;

function ByteToBin(Value: Byte): string;
const
V: Byte = 1;
var
i: Integer;
begin
for i := 7 downto 0 do
if (V shl i) and Value <> 0 then
Result := Result + '1'
else
Result := Result + '0';
end;

function StrRight(Str: string; Len: Integer): string;
begin
if Len >= Length(Str) then
Result := Str
else
Result := Copy(Str, Length(Str) - Len + 1, Len);
end;

function StrLeft(Str: string; Len: Integer): string;
begin
if Len >= Length(Str) then
Result := Str
else
Result := Copy(Str, 1, Len);
end;

function Spc(Len: Integer): string;
begin
SetLength(Result, Len);
FillChar(PChar(Result)^, Len, ' ');
end;

procedure SwapStr(var s1, s2: string);
var
tempstr: string;
begin
tempstr := s1;
s1 := s2;
s2 := tempstr;
end;

//------------------------------------------------------------------------------
// 扩展日期时间操作函数
//------------------------------------------------------------------------------

function GetYear(Date: TDate): Word;
var
m, d: WORD;
begin
DecodeDate(Date, Result, m, d);
end;

function GetMonth(Date: TDate): Word;
var
y, d: WORD;
begin
DecodeDate(Date, y, Result, d);
end;

function GetDay(Date: TDate): Word;
var
y, m: WORD;
begin
DecodeDate(Date, y, m, Result);
end;

function GetHour(Time: TTime): Word;
var
h, m, s, ms: WORD;
begin
DecodeTime(Time, Result, m, s, ms);
end;

function GetMinute(Time: TTime): Word;
var
h, s, ms: WORD;
begin
DecodeTime(Time, h, Result, s, ms);
end;

function GetSecond(Time: TTime): Word;
var
h, m, ms: WORD;
begin
DecodeTime(Time, h, m, Result, ms);
end;

function GetMSecond(Time: TTime): Word;
var
h, m, s: WORD;
begin
DecodeTime(Time, h, m, s, Result);
end;

//------------------------------------------------------------------------------
// 位操作函数
//------------------------------------------------------------------------------

procedure SetBit(var Value: Byte; Bit: TByteBit; IsSet: Boolean); overload;
begin
if IsSet then
Value := Value or (1 shl Bit) else
Value := Value and not(1 shl Bit);
end;

procedure SetBit(var Value: WORD; Bit: TWordBit; IsSet: Boolean); overload;
begin
if IsSet then
Value := Value or (1 shl Bit) else
Value := Value and not(1 shl Bit);
end;

procedure SetBit(var Value: DWORD; Bit: TDWordBit; IsSet: Boolean); overload;
begin
if IsSet then
Value := Value or (1 shl Bit) else
Value := Value and not(1 shl Bit);
end;

function GetBit(Value: Byte; Bit: TByteBit): Boolean; overload;
begin
Result := Value and (1 shl Bit) <> 0;
end;

function GetBit(Value: WORD; Bit: TWordBit): Boolean; overload;
begin
Result := Value and (1 shl Bit) <> 0;
end;

function GetBit(Value: DWORD; Bit: TDWordBit): Boolean; overload;
begin
Result := Value and (1 shl Bit) <> 0;
end;

//------------------------------------------------------------------------------
// 系统功能函数
//------------------------------------------------------------------------------

procedure ChangeFocus(Handle: THandle; Forword: Boolean = False);
begin
if ForWord then
PostMessage(Handle, WM_NEXTDLGCTL, 1, 0)
else
PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
end;

procedure MoveMouseIntoControl(AWinControl: TControl);
var
rtControl: TRect;
begin
rtControl := AWinControl.BoundsRect;
MapWindowPoints(AWinControl.Parent.Handle, 0, rtControl, 2);
SetCursorPos(rtControl.Left + (rtControl.Right - rtControl.Left) div 2,
rtControl.Top + (rtControl.Bottom - rtControl.Top) div 2);
end;

procedure AddComboBoxTextToItems(ComboBox: TComboBox; MaxItemsCount: Integer = 10);
begin
if (ComboBox.Text <> '') and (ComboBox.Items.IndexOf(ComboBox.Text) < 0) then
begin
ComboBox.Items.Insert(0, ComboBox.Text);
while (MaxItemsCount > 1) and (ComboBox.Items.Count > MaxItemsCount) do
ComboBox.Items.Delete(ComboBox.Items.Count - 1);
end;
end;

function DynamicResolution(x, y: WORD): Boolean;
var
lpDevMode: TDeviceMode;
begin
Result := EnumDisplaySettings(nil, 0, lpDevMode);
if Result then
begin
lpDevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := x;
lpDevMode.dmPelsHeight := y;
Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
end;
end;

procedure StayOnTop(Handle: HWND; OnTop: Boolean);
const
csOnTop: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
begin
SetWindowPos(Handle, csOnTop[OnTop], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

var
WndLong: Integer;

procedure SetHidden(Hide: Boolean);
begin
ShowWindow(Application.Handle, SW_HIDE);
if Hide then
SetWindowLong(Application.Handle, GWL_EXSTYLE,
WndLong or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW or WS_EX_TOPMOST)
else
SetWindowLong(Application.Handle, GWL_EXSTYLE, WndLong);
ShowWindow(Application.Handle, SW_SHOW);
end;

const
csWndShowFlag: array[Boolean] of DWORD = (SW_HIDE, SW_RESTORE);

procedure SetTaskBarVisible(Visible: Boolean);
var
wndHandle: THandle;
begin
wndHandle := FindWindow('Shell_TrayWnd', nil);
ShowWindow(wndHandle, csWndShowFlag[Visible]);
end;

procedure SetDesktopVisible(Visible: Boolean);
var
hDesktop: THandle;
begin
hDesktop := FindWindow('Progman', nil);
ShowWindow(hDesktop, csWndShowFlag[Visible]);
end;

function GetWorkRect: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0)
end;

procedure BeginWait;
begin
Screen.Cursor := crHourGlass;
end;

procedure EndWait;
begin
Screen.Cursor := crDefault;
end;

function CheckWindows9598: Boolean;
var
V: TOSVersionInfo;
begin
V.dwOSVersionInfoSize := SizeOf(V);
Result := False;
if not GetVersionEx(V) then Exit;
if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
Result := True;
end;

function GetOSString: string;
var
OSPlatform: string;
BuildNumber: Integer;
begin
Result := 'Unknown Windows Version';
OSPlatform := 'Windows';
BuildNumber := 0;

case Win32Platform of
VER_PLATFORM_WIN32_WINDOWS:
begin
BuildNumber := Win32BuildNumber and $0000FFFF;
case Win32MinorVersion of
0..9:
begin
if Trim(Win32CSDVersion) = 'B' then
OSPlatform := 'Windows 95 OSR2'
else
OSPlatform := 'Windows 95';
end;
10..89:
begin
if Trim(Win32CSDVersion) = 'A' then
OSPlatform := 'Windows 98'
else
OSPlatform := 'Windows 98 SE';
end;
90:
OSPlatform := 'Windows Millennium';
end;
end;
VER_PLATFORM_WIN32_NT:
begin
if Win32MajorVersion in [3, 4] then
OSPlatform := 'Windows NT'
else if Win32MajorVersion = 5 then
begin
case Win32MinorVersion of
0: OSPlatform := 'Windows 2000';
1: OSPlatform := 'Windows XP';
end;
end;
BuildNumber := Win32BuildNumber;
end;
VER_PLATFORM_WIN32s:
begin
OSPlatform := 'Win32s';
BuildNumber := Win32BuildNumber;
end;
end;
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
(Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Trim(Win32CSDVersion) = '' then
Result := Format('%s %d.%d (Build %d)', [OSPlatform, Win32MajorVersion,
Win32MinorVersion, BuildNumber])
else
Result := Format('%s %d.%d (Build %d: %s)', [OSPlatform, Win32MajorVersion,
Win32MinorVersion, BuildNumber, Win32CSDVersion]);
end
else
Result := Format('%s %d.%d', [OSPlatform, Win32MajorVersion, Win32MinorVersion])
end;

function GetComputeNameStr : string;
var
dwBuff : DWORD;
CmpName : array [0..255] of Char;
begin
Result := '';
dwBuff := 256;
FillChar(CmpName, SizeOf(CmpName), 0);
if GetComputerName(CmpName, dwBuff) then
Result := StrPas(CmpName);
end;

function GetLocalUserName: string;
var
Count: DWORD;
begin
Count := 256 + 1; // UNLEN + 1
// set buffer size to 256 + 2 characters
SetLength(Result, Count);
if GetUserName(PChar(Result), Count) then
StrResetLength(Result)
else
Result := '';
end;

function GetLocalIP: String;
type
TaPInAddr = array [0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [0..63] of char;
I : Integer;
GInitData : TWSADATA;

begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^.h_addr_list);
I := 0;
while pptr^[I] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;

//------------------------------------------------------------------------------
// 其它过程
//------------------------------------------------------------------------------

function TrimInt(Value, Min, Max: Integer): Integer; overload;
begin
if Value > Max then
Result := Max
else if Value < Min then
Result := Min
else
Result := Value;
end;

function InBound(Value: Integer; Min, Max: Integer): Boolean;
begin
Result := (Value >= Min) and (Value <= Max);
end;

procedure Delay(const uDelay: DWORD);
var
n: DWORD;
begin
n := GetTickCount;
while ((GetTickCount - n) <= uDelay) do
Application.ProcessMessages;
end;

procedure BeepEx(const Freq: WORD = 1200; const Delay: WORD = 1);
const
FREQ_SCALE = $1193180;
var
Temp: WORD;
begin
Temp := FREQ_SCALE div Freq;
asm
in al,61h;
or al,3;
out 61h,al;
mov al,$b6;
out 43h,al;
mov ax,temp;
out 42h,al;
mov al,ah;
out 42h,al;
end;
Sleep(Delay);
asm
in al,$61;
and al,$fc;
out $61,al;
end;
end;

function GetHzPy(const AHzStr: string): string;
const
ChinaCode: array[0..25, 0..1] of Integer = ((1601, 1636), (1637, 1832), (1833, 2077),
(2078, 2273), (2274, 2301), (2302, 2432), (2433, 2593), (2594, 2786), (9999, 0000),
(2787, 3105), (3106, 3211), (3212, 3471), (3472, 3634), (3635, 3722), (3723, 3729),
(3730, 3857), (3858, 4026), (4027, 4085), (4086, 4389), (4390, 4557), (9999, 0000),
(9999, 0000), (4558, 4683), (4684, 4924), (4925, 5248), (5249, 5589));
var
i, j, HzOrd: Integer;
begin
i := 1;
while i <= Length(AHzStr) do
begin
if (AHzStr[i] >= #160) and (AHzStr[i + 1] >= #160) then
begin
HzOrd := (Ord(AHzStr[i]) - 160) * 100 + Ord(AHzStr[i + 1]) - 160;
for j := 0 to 25 do
begin
if (HzOrd >= ChinaCode[j][0]) and (HzOrd <= ChinaCode[j][1]) then
begin
Result := Result + Char(Byte('A') + j);
Break;
end;
end;
Inc(i);
end else Result := Result + AHzStr[i];
Inc(i);
end;
end;

function UpperCaseMoney(const Money: Double): String;
var
tmp1,rr :string;
l,i,j,k:integer;
r: Double;
const
n1: array[0..9] of string = ('零', '壹', '贰', '叁', '肆',
'伍', '陆', '柒', '捌', '玖');
n2: array[0..3] of string = ('', '拾' ,'佰', '仟');
n3: array[0..2] of string = ('元', '万', '亿');
begin
r:=Money;
tmp1:=FormatFloat('#.00',r);
l:=length(tmp1);
rr:='';
if strtoint(tmp1[l])<>0 then begin
rr:='分';
rr:=n1[strtoint(tmp1[l])]+rr;
end;

if strtoint(tmp1[l-1])<>0 then begin
rr:='角'+rr;
rr:=n1[strtoint(tmp1[l-1])]+rr;
end;

i:=l-3;
j:=0;k:=0;
while i>0 do begin
if j mod 4=0 then begin
rr:=n3[k]+rr;
inc(k);if k>2 then k:=1;
j:=0;
end;
if strtoint(tmp1[i])<>0 then
rr:=n2[j]+rr;
rr:=n1[strtoint(tmp1[i])]+rr;
inc(j);
dec(i);
end;

while pos('零零',rr)>0 do
rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'零亿','亿零',[rfReplaceAll]);
while pos('零零',rr)>0 do
rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'零万','万零',[rfReplaceAll]);
while pos('零零',rr)>0 do
rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'零元','元零',[rfReplaceAll]);
while pos('零零',rr)>0 do
rr:= stringreplace(rr,'零零','零',[rfReplaceAll]);
rr:=stringreplace(rr,'亿万','亿',[rfReplaceAll]);

if copy(rr,length(rr)-1,2)='零' then
rr:=copy(rr,1,length(rr)-2);

result:=rr;
end;

function SoundCardExist: Boolean;
begin
Result := WaveOutGetNumDevs > 0;
end;

initialization
WndLong := GetWindowLong(Application.Handle, GWL_EXSTYLE);

end.

Posted in 软件开发 at March 11, 2008. by 傻猫 .    Views: 5311    1 Comment

汇编级超快字符串替换函数

 用这个函数进行字符串替换操作,比Delphi自带的ReplaceString要快N倍,效率一流,非常快,不愧为汇编级函数操作,哈哈.

下载函数单元文件:freplace.rar

delphi代码

  1. unit FReplace;   
  2.   
  3. interface  
  4.   
  5. Type   
  6. TFastPosProc = function(   
  7. const aSourceString, aFindString : String;   
  8. const aSourceLen, aFindLen, StartPos : integer  
  9. ) : integer;   
  10.   
  11. function FastReplace(   
  12. var aSourceString : String;   
  13. const aFindString, aReplaceString : String;   
  14. CaseSensitive : Boolean = False) : String;   
  15.   
  16. function FastPos(   
  17. const aSourceString, aFindString : String;   
  18. const aSourceLen, aFindLen, StartPos : integer  
  19. ) : integer;   
  20.   
  21. function FastPosNoCase(   
  22. const aSourceString, aFindString : String;   
  23. const aSourceLen, aFindLen, StartPos : integer  
  24. ) : integer;   
  25.   
  26. implementation  
  27.   
  28. // This TYPE declaration will become apparent later.  
  29. //The first thing to note here is that I’m passing the SourceLength and FindL  
  30. //ength. As neither Source nor Find will alter at any point during FastReplace  
  31. //, there’s no need to call the LENGTH subroutine each time!  
  32. function FastPos(   
  33. const aSourceString, aFindString : String;   
  34. const aSourceLen, aFindLen, StartPos : integer  
  35. ) : integer;   
  36. var  
  37. SourceLen : integer;   
  38. begin  
  39.   // Next, we determine how many bytes we need to  
  40.   // scan to find the "start" of aFindString.  
  41.   SourceLen := aSourceLen;   
  42.   SourceLen := SourceLen - aFindLen;   
  43.   if (StartPos-1) > SourceLen then begin  
  44.     Result := 0;   
  45.     Exit;   
  46.   end;   
  47.   SourceLen := SourceLen - StartPos;   
  48.   SourceLen := SourceLen +2;   
  49.   // The ASM starts here.  
  50.   asm  
  51.     // Delphi uses ESI, EDI, and EBX a lot,  
  52.     // so we must preserve them.  
  53.     push ESI   
  54.     push EDI   
  55.     push EBX   
  56.     // Get the address of sourceString[1]  
  57.     // and Add (StartPos-1).  
  58.     // We do this for the purpose of finding  
  59.     // the NEXT occurrence, rather than  
  60.     // always the first!  
  61.     mov EDI, aSourceString   
  62.     add EDI, StartPos   
  63.     Dec EDI   
  64.     // Get the address of aFindString.  
  65.     mov ESI, aFindString   
  66.     // Note how many bytes we need to  
  67.     // look through in aSourceString  
  68.     // to find aFindString.  
  69.     mov ECX, SourceLen   
  70.     // Get the first char of aFindString;  
  71.     // note how it is done outside of the  
  72.     // main loop, as it never changes!  
  73.     Mov  Al, [ESI]   
  74.     // Now the FindFirstCharacter loop!  
  75.     @ScaSB:   
  76.     // Get the value of the current  
  77.     // character in aSourceString.  
  78.     // This is equal to ah := EDI^, that  
  79.     // is what the [] are around [EDI].  
  80.     Mov  Ah, [EDI]   
  81.     // Compare this character with aDestString[1].  
  82.     cmp  Ah,Al   
  83.     // If they're not equal we don't  
  84.     // compare the strings.  
  85.     jne  @NextChar   
  86.     // If they're equal, obviously we do!  
  87.     @CompareStrings:   
  88.     // Put the length of aFindLen in EBX.  
  89.     mov  EBX, aFindLen   
  90.     // We DEC EBX to point to the end of  
  91.     // the string; that is, we don't want to  
  92.     // add 1 if aFindString is 1 in length!  
  93.     dec  EBX   
  94.        
  95.     // add by ShengQuanhu  
  96.     // If EBX is zero, then we've successfully  
  97.     // compared each character; i.e. it's A MATCH!  
  98.     // It will be happened when aFindLen=1  
  99.     Jz @EndOfMatch   
  100.     //add end  
  101.   
  102.     //Here’s another optimization tip. People at this point usually PUSH ESI and  
  103. //so on and then POP ESI and so forth at the end–instead, I opted not to chan  
  104. //ge ESI and so on at all. This saves lots of pushing and popping!  
  105.     @CompareNext:   
  106.     // Get aFindString character +  
  107.     // aFindStringLength (the last char).  
  108.     mov  Al, [ESI+EBX]   
  109.     // Get aSourceString character (current  
  110.     // position + aFindStringLength).  
  111.     mov  Ah, [EDI+EBX]   
  112.     // Compare them.  
  113.     cmp  Al, Ah   
  114.     Jz   @Matches   
  115.     // If they don't match, we put the first char  
  116.     // of aFindString into Al again to continue  
  117.     // looking for the first character.  
  118.     Mov  Al, [ESI]   
  119.     Jmp  @NextChar   
  120.     @Matches:   
  121.     // If they match, we DEC EBX (point to  
  122.     // previous character to compare).  
  123.     Dec  EBX   
  124.     // If EBX <> 0 ("J"ump "N"ot "Z"ero), we  
  125.     // continue comparing strings.  
  126.     Jnz  @CompareNext   
  127.        
  128.     //add by Shengquanhu  
  129.     @EndOfMatch:   
  130.     //add end  
  131.   
  132.     // If EBX is zero, then we've successfully  
  133.     // compared each character; i.e. it's A MATCH!  
  134.     // Move the address of the *current*  
  135.     // character in EDI.  
  136.     // Note, we haven't altered EDI since  
  137.     // the first char was found.  
  138.     mov  EAX, EDI   
  139.     // This is an address, so subtract the  
  140.     // address of aSourceString[1] to get  
  141.     // an actual character position.  
  142.     sub  EAX, aSourceString   
  143.     // Inc EAX to make it 1-based,  
  144.     // rather than 0-based.  
  145.     inc  EAX   
  146.     // Put it into result.  
  147.     mov  Result, EAX   
  148.     // Finish this routine!  
  149.     jmp  @TheEnd   
  150.     @NextChar:   
  151.     //This is where I jump to when I want to continue searching for the first char  
  152. //acter of aFindString in aSearchString:  
  153.     // Point EDI (aFindString[X]) to  
  154.     // the next character.  
  155.     Inc  EDI   
  156.     // Dec ECX tells us that we've checked  
  157.     // another character, and that we're  
  158.     // fast running out of string to check!  
  159.     dec  ECX   
  160.     // If EBX <> 0, then continue scanning  
  161.     // for the first character.  
  162.   
  163.     //add by shengquanhu  
  164.     //if ah is chinese char,jump again  
  165.     jz   @Result0   
  166.     cmp  ah, $80  
  167.     jb   @ScaSB   
  168.     Inc  EDI   
  169.     Dec  ECX   
  170.     //add by shengquanhu end  
  171.   
  172.     jnz  @ScaSB   
  173.        
  174.     //add by shengquanhu  
  175.     @Result0:   
  176.     //add by shengquanhu end  
  177.   
  178.     // If EBX = 0, then move 0 into RESULT.  
  179.     mov  Result,0  
  180.     // Restore EBX, EDI, ESI for Delphi  
  181.     // to work correctly.  
  182.     // Note that they're POPped in the  
  183.     // opposite order they were PUSHed.  
  184.     @TheEnd:   
  185.     pop  EBX   
  186.     pop  EDI   
  187.     pop  ESI   
  188.   end;   
  189. end;   
  190.   
  191. //This routine is an identical copy of FastPOS except where commented! The ide  
  192. //a is that when grabbing bytes, it ANDs them with $df, effectively making the  
  193. //m lowercase before comparing. Maybe this would be quicker if aFindString was  
  194. // made lowercase in one fell swoop at the beginning of the function, saving a  
  195. //n AND instruction each time.  
  196. function FastPosNoCase(   
  197. const aSourceString, aFindString : String;   
  198. const aSourceLen, aFindLen, StartPos : integer  
  199. ) : integer;   
  200. var  
  201. SourceLen : integer;   
  202. begin  
  203.   SourceLen := aSourceLen;   
  204.   SourceLen := SourceLen - aFindLen;   
  205.   if (StartPos-1) > SourceLen then begin  
  206.     Result := 0;   
  207.     Exit;   
  208.   end;   
  209.   SourceLen := SourceLen - StartPos;   
  210.   SourceLen := SourceLen +2;   
  211.   asm  
  212.     push ESI   
  213.     push EDI   
  214.     push EBX   
  215.        
  216.     mov EDI, aSourceString   
  217.     add EDI, StartPos   
  218.     Dec EDI   
  219.     mov ESI, aFindString   
  220.     mov ECX, SourceLen   
  221.     Mov  Al, [ESI]   
  222.        
  223.     //add by shengquanhu:just modified the lowercase 'a'..'z'  
  224.     cmp Al, $7A  
  225.     ja @ScaSB   
  226.        
  227.     cmp Al, $61  
  228.     jb @ScaSB   
  229.     //end------------------------------------------  
  230.   
  231.     // Make Al uppercase.  
  232.     and  Al, $df  
  233.        
  234.     @ScaSB:   
  235.     Mov  Ah, [EDI]   
  236.        
  237.     //add by shengquanhu:just modified the lowercase 'a'..'z'  
  238.     cmp Ah, $7A  
  239.     ja @CompareChar   
  240.        
  241.     cmp Ah, $61  
  242.     jb @CompareChar   
  243.     //end------------------------------------------  
  244.   
  245.     // Make Ah uppercase.  
  246.     and  Ah, $df  
  247.        
  248.     @CompareChar:   
  249.     cmp  Ah,Al   
  250.     jne  @NextChar   
  251.     @CompareStrings:   
  252.     mov  EBX, aFindLen   
  253.     dec  EBX   
  254.        
  255.     //add by ShengQuanhu  
  256.     Jz   @EndOfMatch   
  257.     //add end  
  258.   
  259.     @CompareNext:   
  260.     mov  Al, [ESI+EBX]   
  261.     mov  Ah, [EDI+EBX]   
  262.        
  263.     //add by shengquanhu:just modified the lowercase 'a'..'z'  
  264.     cmp Ah, $7A  
  265.     ja @LowerAh   
  266.        
  267.     cmp Al, $61  
  268.     jb @LowerAh   
  269.     //end------------------------------------------  
  270.   
  271.     // Make Al and Ah uppercase.  
  272.     and  Al, $df  
  273.        
  274.     //add by shengquanhu:just modified the lowercase 'a'..'z'  
  275.     @LowerAh:   
  276.     cmp Ah, $7A  
  277.     ja @CompareChar2   
  278.        
  279.     cmp Ah, $61  
  280.     jb @CompareChar2   
  281.     //end------------------------------------------  
  282.   
  283.     and  Ah, $df  
  284.        
  285.     @CompareChar2:   
  286.     cmp  Al, Ah   
  287.     Jz   @Matches   
  288.     Mov  Al, [ESI]   
  289.        
  290.     //add by shengquanhu:just modified the lowercase 'a'..'z'  
  291.     cmp Al, $7A  
  292.     ja @NextChar   
  293.        
  294.     cmp Al, $61  
  295.     jb @NextChar   
  296.     //end------------------------------------------  
  297.   
  298.     // Make Al uppercase.  
  299.     and  Al, $df  
  300.     Jmp  @NextChar   
  301.     @Matches:   
  302.     Dec  EBX   
  303.     Jnz  @CompareNext   
  304.        
  305.     //add by Shengquanhu  
  306.     @EndOfMatch:   
  307.     //add end  
  308.   
  309.     mov  EAX, EDI   
  310.     sub  EAX, aSourceString   
  311.     inc  EAX   
  312.     mov  Result, EAX   
  313.     jmp  @TheEnd   
  314.     @NextChar:   
  315.     Inc  EDI   
  316.     dec  ECX   
  317.     //add by shengquanhu  
  318.     //if ah is chinese char,jump again  
  319.     jz   @Result0   
  320.     cmp  ah, $80  
  321.     jb   @ScaSB   
  322.     Inc  EDI   
  323.     Dec  ECX   
  324.     //add by shengquanhu end  
  325.     jnz  @ScaSB   
  326.     @Result0:   
  327.     mov  Result,0  
  328.     @TheEnd:   
  329.     pop  EBX   
  330.     pop  EDI   
  331.     pop  ESI   
  332.   end;   
  333. end;   
  334.   
  335. //My move isn’t as fast as MOVE when source and destination are both DWord al  
  336. //igned, but it’s certainly faster when they’re not. As we’re moving charac  
  337. //ters in a string, it isn’t very likely at all that both source and destinat  
  338. //ion are DWord aligned, so moving bytes avoids the cycle penalty of reading/w  
  339. //riting DWords across physical boundaries.  
  340. procedure MyMove(   
  341. const Source; var Dest; Count : Integer);   
  342. asm  
  343.   // Note: When this function is called,  
  344. // Delphi passes the parameters as follows:  
  345. // ECX = Count  
  346. // EAX = Const Source  
  347. // EDX = Var Dest  
  348.   // If there are no bytes to copy, just quit  
  349.   // altogether; there's no point pushing registers.  
  350.   cmp   ECX,0  
  351.   Je    @JustQuit   
  352.   // Preserve the critical Delphi registers.  
  353.   push  ESI   
  354.   push  EDI   
  355.   // Move Source into ESI (generally the  
  356.   // SOURCE register).  
  357.   // Move Dest into EDI (generally the DEST  
  358.   // register for string commands).  
  359.   // This might not actually be necessary,  
  360.   // as I'm not using MOVsb etc.  
  361.   // I might be able to just use EAX and EDX;  
  362.   // there could be a penalty for not using  
  363.   // ESI, EDI, but I doubt it.  
  364.   // This is another thing worth trying!  
  365.   mov   ESI, EAX   
  366.   mov   EDI, EDX   
  367.   // The following loop is the same as repNZ  
  368.   // MovSB, but oddly quicker!  
  369.     @Loop:   
  370.   // Get the source byte.  
  371.   Mov   AL, [ESI]   
  372.   // Point to next byte.  
  373.   Inc   ESI   
  374.   // Put it into the Dest.  
  375.   mov   [EDI], AL   
  376.   // Point dest to next position.  
  377.   Inc   EDI   
  378.   // Dec ECX to note how many we have left to copy.  
  379.   Dec   ECX   
  380.   // If ECX <> 0, then loop.  
  381.   Jnz   @Loop   
  382.   // Another optimization note.  
  383.   // Many people like to do this.  
  384.   // Mov AL, [ESI]  
  385.   // Mov [EDI], Al  
  386.   // Inc ESI  
  387.   // Inc ESI  
  388. //There’s a hidden problem here. I won’t go into too much detail, but the Pe  
  389. //ntium can continue processing instructions while it’s still working out the  
  390. // result of INC ESI or INC EDI. If, however, you use them while they’re stil  
  391. //l being calculated, the processor will stop until they’re calculated (a pen  
  392. //alty). Therefore, I alter ESI and EDI as far in advance as possible of using  
  393. // them.  
  394.   // Pop the critical Delphi registers  
  395.   // that we've altered.  
  396.   pop   EDI   
  397.   pop   ESI   
  398.   @JustQuit:   
  399. end;   
  400.   
  401. //Point 1: I pass VAR aSourceString rather than just aSourceString. This is be  
  402. //cause I’ll just be passed a pointer to the data rather than a 10M copy of t  
  403. //he data itself, which is much quicker!  
  404. function FastReplace(   
  405. var aSourceString : String;   
  406. const aFindString, aReplaceString : String;   
  407. CaseSensitive : Boolean = False) : String;   
  408. var  
  409. // Size already passed to SetLength,  
  410.   // the REAL size of RESULT.  
  411.   ActualResultLen,   
  412. // Position of aFindString is aSourceString.  
  413.   CurrentPos,   
  414. // Last position the aFindString was found at.  
  415.   LastPos,   
  416. // Bytes to copy (that is, lastpos to this pos).  
  417.   BytesToCopy,   
  418. // The "running" result length, not the actual one.  
  419.   ResultLen,   
  420. // Length of aFindString, to save  
  421.   // calling LENGTH repetitively.  
  422.   FindLen,   
  423. // Length of aReplaceString, for the same reason.  
  424.   ReplaceLen,   
  425. SourceLen         : Integer;   
  426. // This is where I explain the  
  427.   // TYPE TFastPosProc from earlier!  
  428.   FastPosProc       : TFastPosProc;   
  429. begin  
  430.   //As this function has the option of being case-insensitive, I’d need to call  
  431. // either FastPOS or FastPOSNoCase. The problem is that you’d have to do this  
  432. // within a loop. This is a bad idea, since the result never changes throughou  
  433. //t the whole operation–in which case we can determine it in advance, like so  
  434. //:  
  435.   if CaseSensitive then  
  436.   FastPosProc := FastPOS   
  437.   else  
  438.   FastPOSProc := FastPOSNoCase;   
  439.   // I don't think I actually need  
  440.   // this, but I don't really mind!  
  441.   Result := '';   
  442.   // Get the lengths of the strings.  
  443.   FindLen := Length(aFindString);   
  444.   ReplaceLen := Length(aReplaceString);   
  445.   SourceLen := Length(aSourceString);   
  446.   // If we already have room for the replacements,  
  447.   // then set the length of the result to  
  448.   // the length of the SourceString.  
  449.   if ReplaceLen <= FindLen then  
  450.   ActualResultLen := SourceLen   
  451.   else  
  452.   // If not, we need to calculate the  
  453.     // worst-case scenario.  
  454.     // That is, the Source consists ONLY of  
  455.     // aFindString, and we're going to replace  
  456.     // every one of them!  
  457.     ActualResultLen :=   
  458.   SourceLen +   
  459.   (SourceLen * ReplaceLen div FindLen) +   
  460.   ReplaceLen;   
  461.   // Set the length of Result; this  
  462.   // will assign the memory, etc.  
  463.   SetLength(Result,ActualResultLen);   
  464.   CurrentPos := 1;   
  465.   ResultLen := 0;   
  466.   LastPos := 1;   
  467.   //Again, I’m eliminating an IF statement in a loop by repeating code–this ap  
  468. //proach results in very slightly larger code, but if ever you can trade some  
  469. //memory in exchange for speed, go for it!  
  470.   if ReplaceLen > 0 then begin  
  471.     repeat  
  472.     // Get the position of the first (or next)  
  473.       // aFindString in aSourceString.  
  474.       // Note that there's no If CaseSensitive,  
  475.       // I just call FastPOSProc, which is pointing  
  476.       // to the correct pre-determined routine.  
  477.       CurrentPos :=   
  478.     FastPosProc(aSourceString, aFindString,   
  479.     SourceLen, FindLen, CurrentPos);   
  480.     // If 0, then we're finished.  
  481.       if CurrentPos = 0 then break;   
  482.     // Number of bytes to copy from the  
  483.       // source string is CurrentPos - lastPos,  
  484.       // i.e. " cat " in "the cat the".  
  485.       BytesToCopy := CurrentPos-LastPos;   
  486.     // Copy chars from aSourceString  
  487.       // to the end of Result.  
  488.       MyMove(aSourceString[LastPos],   
  489.     Result[ResultLen+1], BytesToCopy);   
  490.     // Copy chars 

Posted in 软件开发 at October 23, 2007. by 傻猫 .    Views: 4041    No Comments

IsNumeric 判断字符串是否为数字

IsNumeric 判断字符串是否为数字,如果是数字返回true,如果包含有汉字或字符的话返回false.  由于Delphi本身没有IsNumeric这个函数,不像其它语言,这个函数相当于Java的IsNaN函数。

delphi代码
  1. function  IsNumeric(AStr:   string):   Boolean;   
  2. var  
  3.       Value:   Double;   
  4.       Code:   Integer;   
  5. begin  
  6.       Val(AStr,   Value,   Code);   
  7.       result   :=   Code   =   0;   
  8. end;  
Posted in 软件开发 at October 22, 2007. by 傻猫 .    Views: 4675    No Comments

WinExecAndWait32调用外部程序,等待外部程序运行完成

 调用外部程序,等待外部程序运行完成,相当于Showmodal功能,呵呵

delphi代码
  1. function WinExecAndWait32(FileName: string; Visibility: Boolean): integer;   
  2. var  
  3.   zAppName: array[0..512of char//存放应用程序名  
  4.   StartupInfo: TStartupInfo;   
  5.   ProcessInfo: TProcessInformation;   
  6.   exitCode: Dword;   
  7.   aVisibility: integer;   
  8. begin  
  9.   StrPCopy(zAppName, FileName);   
  10.   FillChar(StartupInfo, Sizeof(StartupInfo), #0);   
  11.   //给StartupInfo结构体赋值  
  12.   StartupInfo.cb := Sizeof(StartupInfo);   
  13.   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;   
  14.   if Visibility then  
  15.     aVisibility := 1  
  16.   else  
  17.     aVisibility := 0;   
  18.   
  19.   StartupInfo.wShowWindow := aVisibility;   
  20.   //调用CreateProcess 创建进程,执行指定的可执行文件  
  21.   if not CreateProcess(nil, zAppName, nilnilfalse  
  22.     , CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS   
  23.     , nilnil, StartupInfo, ProcessInfo) then  
  24.     Result := -1  
  25.   else  
  26.   begin  
  27.     //等待可执行文件退出  
  28.     WaitforSingleObject(ProcessInfo.hProcess, INFINITE);   
  29.     //得到进程终止状态码  
  30.     GetExitCodeProcess(ProcessInfo.hProcess, exitCode);   
  31.     result := Exitcode;   
  32.   end;   
  33. end;  
Posted in 软件开发 at October 22, 2007. by 傻猫 .    Views: 5838    No Comments

Delphi集成Windows验证登录函数

The first and biggest of these restrictions is that on Windows NT and Windows 2000, the process that is calling LogonUser must have the SE_TCB_NAME privilege (in User Manager, this is the ""Act as part of the Operating System"" right). The SE_TCB_NAME privilege is very powerful and should not be granted to any arbitrary user just so that they can run an application that needs to validate credentials. The recommended method is to call LogonUser from a service that is running in the local system account, because the local system account already has the SE_TCB_NAME privilege.  

delphi代码
  1. function   VerifyWindowsUser(const   Machine,Username,Password:String):boolean;      
  2.   var   hToken:THandle;      
  3.   begin      
  4.     hToken:=0;      
  5.     Result:=LogonUser(PChar(UserName),PChar(Machine),PChar(Password),LOGON32_LOGON_INTERACTIVE,LOGON32_PROVIDER_DEFAULT,hToken);      
  6.     if(hToken<>0)then      
  7.       CloseHandle(hToken);      
  8.   end;     
Posted in 软件开发 at October 17, 2007. by 傻猫 .    Views: 4251    No Comments

Delphi函数返回多个值

今天在搞一个程序中,要求返回多个值,我知道用数组使用,但以前还没有做过,于是在网上找了一下,得到这个东东,原来自己定义一个类型,然后将函数的类型设为自定义类型就可以了,我定义的是字符串数组,函数返回值当然是多个字符串了,呵呵。

可以函数过程中设定返回数组的大小,SetLength (result,5)就可以。

delphi代码
  1. type  
  2.         k=array of integer;   
  3.   
  4. function abc(i:integer):k;   
  5. var  
  6.     j:integer;   
  7. begin  
  8.     SetLength (result,5);   
  9.     for j:=0 to i do  
  10.         result[j]:=j;   
  11. end;   
  12.   
  13. procedure TForm1.FormCreate(Sender: TObject);   
  14. begin  
  15.     self.Caption := inttostr(abc(5)[5]);   
  16. end;  
Posted in 软件开发 at October 11, 2007. by 傻猫 .    Views: 5764    No Comments