不能改变环境就改变自己了。
作者：傻猫 发布时间：September 15, 2007 分类：傻猫软件
今天给一个朋友搞了一个《ADSL自动拨号程序》的程序。
主要功能：自动换IP地址，自动获取本地ADSL连接，定时自动拨号，自动缩小到状态栏，拨号日志记录，IP地址记录
可以用来刷IP地址用，刷网站等等。呵呵，功能很少，但是很实用！现在发布出来给大家用用，并提供源码下载，代码有点乱，老鸟就可以略过了，仅供学习交流使用，欢迎大家提出建议！
开发平台：Delphi7 + WindowsXp xp2
使用控件：Dial拨号控件，cnPack Tray
程序下载：dialup.rar
源代码下载：dialup(src).rar
控件下载：dialup.rar
作者：傻猫 发布时间：July 7, 2007 分类：Delphi
第一种:使用API函数FindWindow
hw:=FindWindow(nil,PChar('窗口的标题名称'));
第二种:通过枚举所有窗口,查询特定条件的窗口
function EnumWindowsProc(Wnd: HWND; Param: Integer): Boolean; stdcall;
var
cn : Array[0..255] of char;
tab : HWND;
tId : DWORD;
begin
Result := TRUE;
if GetClassName(wnd, cn, 255) > 0 then
if cn = '#32770' then
begin
if (FindWindowEx(wnd, 0, 'Button','新建窗口') <> 0) and
(FindWindowEx(wnd, 0, 'Button','拨打电话') <> 0) and
(FindWindowEx(wnd, 0, 'Button','发送(Enter)') <> 0) then
begin
tID := GetWindowThreadProcessID(wnd, nil);
Form1.Memo1.Lines.Add('对话框句柄：'+IntToStr(Wnd));
Form1.Memo1.Lines.Add('对话框线程ID：' + IntToSTr(tID));
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,0);
end;
第三种: 查找字窗口内元素的句柄
FindWindowEx(wnd, 0, 'Button','拨打电话')
第四种: 直接使用类似spy++工具软件查询
作者：傻猫 发布时间：June 24, 2007 分类：Delphi
Webservices offer a rich world of functionality. This world is available to the Delphi programmer with the introduction of the Webservice importer introduced in Delphi 6, with version 6.02 also available in Delphi pro. A webservice can work with pretty complex data, with .NET it is a snap to return and receive complete XML datasets. Delphi does not know how to work with these datasets natively. In this paper I will show how to work with .NET data using the GekkoDotNetDataset componenet.
The webservice I am going to build will be a web-wrapper round a database. The database is an Access database local on the web-server. It contains customers, invoices and invoice details.
Methods of the webservice will expose this data to the web as strongly typed XML datasets. Other methods will accept XML datasets to update the database. Importing these tables in a .NET application will result in a nice XSD schema
For a step by step story how to build such a service you can read one of my dotnetjunkies stories, for the moment I will concentrate on the actual webmethods.
The Customers method returns a dataset containing all customers. It does so by creating a new typed dataset object : DataSetCustomers. This object is filled by the oleDbDataAdapter, the internals of this component do the real access to the database.
public DataSetCustomers Customers()
{
DataSetCustomers ds = new DataSetCustomers();
oleDbDataAdapterCustomers.Fill(ds);
return ds;
}
The entire resulting XML dataset is returned. One of the many nice things of an XML dataset is that it can be serialized, it can be represented as one long string of characters. Which is something which is very easy to transport over the standard HTTP protocol.
To fill the contents of the invoices dataset, as described by the schema, takes a little more effort. The three tables can live together in one dataset but for every table another oleDbDataAdapter is needed.
[WebMethod]
{
DataSetInvoices ds = new DataSetInvoices();
oleDbDataAdapterCustomers.Fill(ds.Customers);
oleDbDataAdapterInvoices.Fill(ds.Invoices);
oleDbDataAdapterInvoiceDetails.Fill(ds.InvoiceDetails);
return ds;
}
Using dataAdapters all query possibilities of the database can be used. For an example you are still invited at the dotnetjunkies. DataAdapters can also be used to write to a database. The updates to be written are passed as a typed XML dataset. Which make the implementation of of the webmethod a one-liner:
[WebMethod]
{
oleDbDataAdapterCustomers.Update(ds.Customers);
}
Multiple tables can be updated in one go in the UpdateInvoices method. The order in these updates will be performed is important:
[WebMethod]
{
oleDbDataAdapterCustomers.Update(ds.Customers);
oleDbDataAdapterInvoices.Update(ds.Invoices);
oleDbDataAdapterInvoiceDetails.Update(ds.InvoiceDetails);
}
You cannot enter a new invoice if you don't know the customer yet. These integrity checks are also performed in an .NET XML dataset object. But in there they can be switched off by setting the EnforceConstraints property to false.
In .NET you can build a windows client application which imports the webservice and it will work perfect with all functionality of the webservice. Which means that a windows application can update an Access database somewhere on a webserver on the other side of the globe using plain HTTP.
The client reads that data from the webserver like this
localhost.DataSetWebService ws =
dataSetCustomers1.Clear();
dataSetCustomers1.Merge(ws.Customers());
The dataset is bound to a grid. Here the user can do some editing after which the update is invoked
localhost.DataSetWebService ws =
ws.UpDateCustomers(dataSetCustomers1);
See this consumer at work in the dotnetjunkies story.
It would be very nice to work with this webservice in Delphi. I will use Delphi 6.02 pro which has full support for webservices clients. Delphi has a webservice importer which is found under the file | New | Other | Webservices menu. After entering the URL of the webservice Delphi will generate a unit describing the webservice.
The webservice has two types, being the Customers and the Invoices XSD schema. The service has four methods who use these types in their parameters or as result-type. And this is what the Delphi makes out of it :
Which looks pretty disappointing. The Return types of Customers and Invoices webmethods are recognized as composite types Customers and Invoices. Alas, these types contain no members at all. Things get worse with the update methods. Both have a parameter named ds of type Invoices or Customers. The importer generates two methods with a parameter named ds of a type named ds as well. This ds type is declared and does not have any members either. That's not going to work. Many webservices work very well with Delphi but in this case it will need some extra help.
I have built the GekkoDotNetDataSet component. This component is based on the HTTPrio component and can be found in the demo code. It takes the following approach to the problem:
The component introduces two new published events and one new published property, visible in the object inspector.
The component has two public methods and two public properties to read and write data
This componenet is part of the GekkoDotNetPackage, it will install itself on the webservices page.
I drop two of these components on the form. One for the Web Services' Customers dataset and the other for the Invoices dataset. Despite it's emptiness I can use the imported Service1.pas. The GekkoDotNetDataSet component is a HTTPrio descendent so I have to set the WSDLlocation in both components , it will be http://localhost/WebServices/DataService/Service1.asmx?wsdl. The component's only new property is ParamName, it is the name of the parameter of the Update methode, ds for both components.
The real new stuff is in two new events. These get fired when the component Get's or Update's data. As the component does not know which member of the webservice to invoke to read or write data it will make a callback to the component's user. Requesting the user to do the actual invoke.
procedure TForm1.DataSetCustomersRequestGetInvocation(Sender: TObject);
var Iservice : DataSetWEbServiceSoap;
begin
Iservice:= DataSetCustomers as DataSetWebServiceSoap;
Iservice.Customers;
end;
You have to get to the actual webservice by typecasting the component to the interface of the service, which can be done because the component is a HTTPrio wrapping up the webservice. The declaration of DataSetWebServiceSoapis in the imported Service1.pas. On this interface you call the function which will return the intended XML dataset. In the requestGetInvocation-eventhandler of the other componenent the Invoices method will be invoked.
The click of a button will fill the form with a dataset, which dataset depends on a radiogroup
procedure TForm1.ButtonGetClick(Sender: TObject);
var i : integer;
DNdataSet : TGekkoDotNetDataSet;
begin
case RadioGroup1.ItemIndex of
0 : DNdataSet:= DataSetCustomers;
1 : DNdataSet:= DataSetInvoices;
else DNdataSet:= nil;
end;
if Assigned(DNdataSet) then
begin
DNdataSet.Get;
CreateDataGrids(DNdataSet);
end;
end;
By calling get on the customers dataset the DataSetCustomersRequestGetInvocation eventhandler will be executed. Which will make the right invocation.
Now the tables of the are filled I will show what's in them. The form has an empty pagecontrol. For every dataset a page is added to the pagecontrol :
procedure TForm1.CreateDataGrids(Sender: TObject);
var tP : tTabSheet;
ds : tDataSource;
dn : tDBNavigator;
dg : tDBGrid;
i : integer;
DNdataSet : TGekkoDotNetDataSet;
begin
DNdataSet:= sender as TGekkoDotNetDataSet;
if DNdataSet <> nil then
begin
for i:= 0 to DNdataSet.TableCount - 1 do
begin
tP:=tTabSheet.Create(self);
tP.PageControl:= PageControl1;
tP.Caption:= DNdataSet.DataTable[i].Name;
ds:= tDataSource.Create(Self);
dn:= tDBnavigator.Create(self);
dn.Align:= alTop;
dn.Parent:= tP;
dn.DataSource:= ds;
dg:= tDBGrid.Create(self);
dg.Align:= alClient;
dg.Parent:= tP;
dg.DataSource:= ds;
ds.DataSet:= DNdataSet.DataTable[i];
end;
end;
end;
For every (client-)dataset in the GekkoDotNetDataSet I create a new page with a datagrid and a dbNavigator.
When running this application I can browse and update the data in my Delphi form.
To return all updates to the webservice the component uses another event
procedure TForm1.DataSetInvoicesRequestUpdateInvocation(Sender: TObject);
var Iservice : DataSetWEbServiceSoap;
begin
Iservice:= DataSetInvoices as DataSetWebServiceSoap;
Iservice.UpDateInvoices(ds.Create);
end;
This event is fired by the componenet when it's Updatemethodis called. The component does not know which member to invoke, in this eventhandler the component' user is requested to invoke the desired method. Theds class is declared in the imported unit. It has no members but it will do to invoke the method.
The form sends the updates by the click of a button
procedure TForm1.ButtonSaveClick(Sender: TObject);
var DNdataSet : TGekkoDotNetDataSet;
begin
case RadioGroup1.ItemIndex of
0 : DNdataSet:= DataSetCustomers;
1 : DNdataSet:= DataSetInvoices;
else DNdataSet:= nil;
end;
if Assigned(DnDataSet) then
DNdataSet.Update;
end;
Now we have a Delphi application which works with a .NET webservice and can read or write XML dataset data.
To get an idea what is going on I have set the GekkoDotNetDataSet componenet's before- and after- execution event to show the full SOAP request and response in explorer windows.
The request is passed to the eventhandler as a string and the response as a stream. The ShowXMLmethod will send the stream to a browser, it does so by saving the xml as a temporary file and pointing a browser to it. In the BeforeExcute event the string request has to be written to a stream before being sent to the ShowXML method.
procedure TForm1.HTTPRIO1BeforeExecute(const MethodName: String; var SOAPRequest: WideString);
var ts : tStringStream;
buffer : string;
begin
buffer:= SOAPrequest;
ts:= tStringStream.Create(buffer);
Showxml(ts, Send);
end;
procedure TForm1.HTTPRIO1AfterExecute(const MethodName: String; SOAPResponse: TStream);
begin
ShowXML(SOAPResponse, Receive);
end;
Now you can see the full requests as they are sent to the .NET webservice and the response.
The GekkoDotNetDataSet component relies on the tDNdataSet, whose internals are described in another paper. The class has been created by trial and error in investigating the results of .NET built webservices. If you want to use the class in your own code please consider the following points (this is a disclaimer !)
You are welcome to experiment with the component and any suggestions, remarks, comments, or other feedback will be greatly appreciated. It will all be used in the updates.
In this paper we have seen how a Delphi webservice client can work with a webservice which works with XML (diffgram) datasets. All functionality is stored in the GekkoDotNetDataSet component, which is based on Delphi's HTTPrio component.
作者：傻猫 发布时间：June 20, 2007 分类：Delphi
use shellAPI;
procedure TForm1.Button1Click(Sender: TObject);
Var
T : TSHFileOpStruct;
P:String;
begin
P:= Edit1.Text;//目录名
With T do
Begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar(P);
pTo:=nil;
fFlags:=FOF_ALLOWUNDO+FOF_NOCONFIRMATION+FOF_NOERRORUI;//标志表明允许恢复，无须确认并不显示出错信息
hNameMappings:=nil;
lpszProgressTitle:='正在删除文件夹';
fAnyOperationsAborted:=False;
End;
SHFileOperation(T);
end;
作者：傻猫 发布时间：January 11, 2007 分类：Delphi
假设您已经在.net上建立了自己的webservice，目前只是想在delphi上实现对net上自己的webservice 接口的调用
1) 在你的工程中 new -> other 选择 webservices 这页
2) 选择其中的 wsdl importer 项
3) 在其中的wsdl source中填入你已经知道的wdsl地址，这里我填入我的地址是
http://192.168.0.123/hello/tijiaosj.asmx?wsdl
4) next后 就自动生成了一个unit
5) 这个unit中包含了你提供的url地址中的所有可用接口
其中 GetXXXXXSoap 这个函数返回了这些接口的class
在业务代码中只要写 GetXXXXXSoap.XXXfunction就可以了
6) 另外提当函数要操作中文的时候，记得修改GetXXXXXSoap，添加这条语句
RIO.HTTPWebNode.UseUTF8InHeader := True; //解决中文乱码问题
呵呵，很简单，对吧
最后，稍微改了一下Delphi生成的接口单元
改动的地方为：
7). 添加接口的执行选项默认为 ioDocument
如果是JAVA 接口, 将执行选项改为 ioLiteral 即可.
修改后的代码如下:
InvRegistry.RegisterInvokeOptions(TypeInfo(XcdsExPortType), ioDocument);
作者：傻猫 发布时间：July 9, 2006 分类：Delphi
动态使用代理服务器，今天我自己封装了一个函数，在盒子上面下载一个源码，把里边的过程综合了一下，封装成一个代理专用的函数，呵呵，收藏起来，方便以后使用。另外还有一种方法也可以使用代理服务器，那就是ihttp下载文件的时候使用代理服务器。
function SetProxy(proxyS,proxyP:string;isUse:BOOL);
//proxyS: 代理服务器IP地址
//proxyP: 代理服务器端口
//isUse: true表示启用 false表示停用
var FProxy,proxy,port: string;
Pinfo: INTERNET_PROXY_INFO;
reg: Tregistry;
begin
//设置代理服务器
proxy:=proxyS; //服务器地址
port:=proxyP; //服务器端口
FProxy:=Format('%s:%s',[Proxy,port]);
Pinfo.dwAccessType := INTERNET_OPEN_TYPE_PROXY;
Pinfo.lpszProxy := pchar(proxy);
//Pinfo.lpszProxy := pchar(FProxy);
InternetSetOption(nil, INTERNET_OPTION_PROXY, @Pinfo, SizeOf(PInfo));
InternetSetOption(nil, INTERNET_OPTION_SETTINGS_CHANGED, nil, 0);
//根据参数来调整注册表
reg:=Tregistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
if reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet Settings', True) then
begin
reg.Writestring('ProxyServer', FMproxy);
if isUse then
reg.WriteInteger('ProxyEnable', integer(true))
else
reg.WriteInteger('ProxyEnable', integer(false));
end;
finally
reg.CloseKey;
reg.free;
end;
end;
使用idhttp控件，调整代理服务器参数也可以实现通过代理服务器访问。
idhttp1.ProxyParams.ProxyServer :=proxyip.Text ;//代理地址
idhttp1.ProxyParams.ProxyPort :=StrToInt(port.text);//端口
//如果代理需要验证
idhttp1.ProxyParams.ProxyUsername:=uname.Text ;//用户名
idhttp1.ProxyParams.ProxyPassword:=pw.Text ; //密码
作者：傻猫 发布时间：June 8, 2006 分类：Delphi
1、选择菜单View -> Project Source。
2、在uses子句中添加Windows单元。
3、在Application.Initialize;之后添加Application.ShowMainForm := False;。
4、在Application.Run;之前添加ShowWindow(Application.Handle, SW_HIDE);。
你的主工程应该是这样的：
program Project1;
uses
Windows,
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.RES}
begin
Application.Initialize;
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
ShowWindow(Application.Handle, SW_HIDE);
Application.Run;
end.
在每个单元的initialization部分(在最下面)添加:
begin
ShowWindow(Application.Handle, SW_HIDE);
end.
作者：傻猫 发布时间：May 8, 2006 分类：Delphi
[php]
copy(str,pos,num) 从str字符串的pos处开始,截取num个字符的串返回.假设str为'abcdef',copy(str,3,2)='cd',copy(str,4,10)='def'
concat(str1,str2{,strn}) 把各自变量连接起来,返回连接后的字符串(长度不能超过255)
length(str) 返回str的字符个数,即其长度.
pos(obj,target) 在target字符串中找出第一个出现obj的第一个字符位置,如果找不到,返回0.
AnsiStrLastChar('你好')结果是“好”。如果有半个汉字出现,返回这半个汉字。二者字符串长度分别为2和1。
CompareStr - 区分大小写
CompareText - 不区分大小写
////////////////////////////////////////////////////////
{判断字符是否是数字}
function IsDigit(ch: char): boolean;
begin
Result := ch in ['0'..'9'];
end;
{判断字符是否是大写字符}
function IsUpper(ch: char): boolean;
begin
Result := ch in ['A'..'Z'];
end;
{判断字符是否是小写字符}
function IsLower(ch: char): boolean;
begin
Result := ch in ['a'..'z'];
end;
{转换为大写字符}
function ToUpper(ch: char): char;
begin
Result := chr(ord(ch) and $DF);
end;
{转换为小写字符}
function ToLower(ch: char): char;
begin
Result := chr(ord(ch) or $20);
end;
{ Capitalizes first letter of every word in s }
function Proper(const s: string): string;
var
i: Integer;
CapitalizeNextLetter: Boolean;
begin
Result := LowerCase(s);
CapitalizeNextLetter := True;
for i := 1 to Length(Result) do
begin
if CapitalizeNextLetter and IsLower(Result[i]) then
Result[i] := ToUpper(Result[i]);
CapitalizeNextLetter := Result[i] = ' ';
end;
end;
////////////////////////////////////////////////////////////
{返回两个子字符串之间字符的个数}
Function p2pcount( s, ss1, ss2 : string ): integer;
var i, j, slen : integer;
begin
i := pos( ss1, s );
j := pos( ss2, s );
slen := Length(ss2);
if j >= i then Result := j - i + slen else Result := 0;
end;
{更快速的字符查询,快40%}
function ScanStr(ToScan: PChar; Sign: Char):PChar;
begin
Result:= nil;
if ToScan <> nil then
while (ToScan^ <> #0) do begin
if ToScan^ = Sign then begin
Result:= ToScan;
break;
end;
inc(ToScan);
end;
end;
/////////////////////////////
替换字符串中子串的函数,他可以从字符串中找出指定子串,并替换为另一子串。
function replacing(S,source,target:string):string;
var site,StrLen:integer;
begin
{source在S中出现的位置}
site:=pos(source,s);
{source的长度}
StrLen:=length(source);
{删除source字符串}
delete(s,site,StrLen);
{插入target字符串到S中}
insert(target,s,site);
{返回新串}
replacing:=s;
end;
///////////////////////
另两个替换字符串中子串的函数
function repl_substr( sub1, sub2, s: string ): string;
var i: integer;
begin
repeat
i := pos( sub1, s ) ;
if i > 0 then begin
delete( s, i, Length(sub1));
insert( sub2, s, i );
end;
until i < 1;
Result := s;
end;
function ReplaceText(const S,ReplacePiece,ReplaceWith: String):String;
Var Position: Integer;
TempStr: String;
begin
Position := Pos(ReplacePiece,S);
if Position > 0 then Begin
TempStr := S;
Delete(TempStr,1,Position-1+Length(ReplacePiece));
Result :=
Copy(S,1,Position-1)+ReplaceWith+ReplaceText(TempStr,ReplacePiece,ReplaceWith)
End else Result := S;
end;
////////////////////////
替换全部子字符串的函数
function ReplaceSub(str, sub1, sub2: String): String;
var
aPos: Integer;
rslt: String;
begin
aPos := Pos(sub1, str);
rslt := '';
while (aPos <> 0) do begin
rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
Delete(str, 1, aPos + Length(sub1));
aPos := Pos(sub1, str);
end;
Result := rslt + str;
end;
/////////////////////////
在字符串左右填充指定数量的指定字符
function UT_PadString(inString :string; maxLength :integer; padChar :char;
left :boolean) :string;
begin
result := inString;
while (Length(result) < maxLength) do
if (left) then
result := padChar + result
else
result := result + padChar;
end;
/////////////////////////////////////
提取字符串中指定子字符串前的字符串
Function Before ( Src:string ; Var S:string ) : string ;
Var
F : Word ;
begin
F := POS (Src,S) ;
if F=0 then
Before := S
else
Before := COPY(S,1,F-1) ;
end ;
//////////////////////////////////
提取字符串中指定子字符串后的字符串
Function After ( Src:string ; Var S:string ) : string ;
Var
F : Word ;
begin
F := POS (Src,S) ;
if F=0 then
After := ''
else
After := COPY(S,F+length(src),length(s)) ;
end ;
////////////////////////////////////
判断字符串是否可以转换为整数
function IsIntStr(const S: string): boolean;
begin
Result:=StrToIntDef(S,0)=StrToIntDef(S,1);
end;
//////////////////////////////////////
从字符串中删除指定字符串
procedure RemoveInvalid(what, where: string): string;
var
tstr: string;
begin
tstr:=where;
while pos(what, tstr)>0 do
tstr:=copy(tstr,1,pos(what,tstr)-1) +
copy(tstr,pos(what,tstr)+length(tstr),length(tstr));
Result:=tstr;
end;
用法:
NewStr:=RemoveInvalid('<invalid>','This <invalid> is my string and I wan to
remove the word <invalid>');
///////////////////////////////////////////
根据某个字符分割字符串的函数
procedure SeparateTerms(s : string;Separator : char;Terms : TStringList);
{ This browses a string and divide it into terms whenever the given
separator is found. The separators will be removed }
var
hs : string;
p : integer;
begin
Terms.Clear; // First remove all remaining terms
if Length(s)=0 then // Nothin' to separate
Exit;
p:=Pos(Separator,s);
while P<>0 do
begin
hs:=Copy(s,1,p-1); // Copy term
Terms.Add(hs); // Add to list
Delete(s,1,p); // Remove term and separator
p:=Pos(Separator,s); // Search next separator
end;
if Length(s)>0 then
Terms.Add(s); // Add remaining term
end;
==========
= 用 法
==========
var
Terms : TStringList;
i : integer;
const
TestStr = '1st term;2nd term;3rd term';
begin
Terms:=TStringList.Create;
SeparateTerms(TestStr,';',Terms);
for i:=0 to terms.Count-1 do
ShowMessage(Terms.Strings[i]);
Terms.Free;
end;
/////////////////////////////
根据一组字符分割字符串的函数
type
Charset = set of Char;
var
f : Text;
s : String;
procedure WriteStringSplitted(var s: String; Separators: Charset);
var
a,e : Integer; {anfang und ende des w鰎tchens}
begin
a := 1;
for e := 1 to Length(s) do
if s[e] in Separators then begin
WriteLn(Copy(s, a, e-a));
a := e + 1;
end;
WriteLn(Copy(s, a, e-a+1));
end;
begin
Assign(f, 'c:\dingsbums\text.txt');
Reset(f);
while not EOF(f) do begin
ReadLn(f,s);
WriteStringSplitted(s, [':', ',']);
end;
Close(f);
end.
//////////////////////////////////////////////////
{===============================================================}
{ 函数 : RESULTSTRING = HexToBin(HEXSTRING)
{ 目的 : 把十六进制字符串转换为二进制字符串
{
{===============================================================}
{ 函数 : RESULTINTEGER = HexCharToInt(HEXCHAR)
{ 目的 : 转换一个十六进制字符为整数
{===============================================================}
{ 函数 : RESULTSTRING = HexCharToBin(HEXCHAR)
{ 目的 : 转换一个十六进制字符为二进制字符串
{===============================================================}
{ 函数 : RESULTINTEGER = Pow(BASE,POWER)
{ 目的 : 指数函数
{===============================================================}
{ 函数 : RESULTINTEGER = BinStrToInt(BINSTRING)
{ 目的 : 把二进制字符串转换为整数
{===============================================================}
{ 函数 : RESULTSTRING = DecodeSMS7Bit (PDUSTRING)
{ 目的 : 解码一个7-bit SMS (GSM 03.38) 为ASCII码
{===============================================================}
{ 函数 : RESULTSTRING = ReverseStr (SOURCESTRING)
{ 目的 : 反转一个字符串
{===============================================================}
unit BinHexTools;
interface
function HexToBin(HexNr : string): string;
function HexCharToInt(HexToken : char):Integer;
function HexCharToBin(HexToken : char): string;
function pow(base, power: integer): integer;
function BinStrToInt(BinStr : string) : integer;
function DecodeSMS7Bit(PDU : string):string;
function ReverseStr(SourceStr : string) : string;
implementation
uses sysutils, dialogs;
function HexCharToInt(HexToken : char):Integer;
begin
{if HexToken>#97 then HexToken:=Chr(Ord(HexToken)-32);
{ use lowercase aswell }
Result:=0;
if (HexToken>#47) and (HexToken<#58) then { chars 0....9 }
Result:=Ord(HexToken)-48
else if (HexToken>#64) and (HexToken<#71) then { chars A....F }
Result:=Ord(HexToken)-65 + 10;
end;
function HexCharToBin(HexToken : char): string;
var DivLeft : integer;
begin
DivLeft:=HexCharToInt(HexToken); { first HEX->BIN }
Result:='';
{ Use reverse dividing }
repeat { Trick; divide by 2 }
if odd(DivLeft) then { result = odd ? then bit = 1 }
Result:='1'+Result { result = even ? then bit = 0 }
else
Result:='0'+Result;
DivLeft:=DivLeft div 2; { keep dividing till 0 left and length = 4 }
until (DivLeft=0) and (length(Result)=4); { 1 token = nibble = 4 bits }
end;
function HexToBin(HexNr : string): string;
{ only stringsize is limit of binnr }
var Counter : integer;
begin
Result:='';
for Counter:=1 to length(HexNr) do
Result:=Result+HexCharToBin(HexNr[Counter]);
end;
function pow(base, power: integer): integer;
var counter : integer;
begin
Result:=1;
for counter:=1 to power do
Result:=Result*base;
end;
function BinStrToInt(BinStr : string) : integer;
var counter : integer;
begin
if length(BinStr)>16 then
raise ERangeError.Create(#13+BinStr+#13+
'is not within the valid range of a 16 bit binary.'+#13);
Result:=0;
for counter:=1 to length(BinStr) do
if BinStr[Counter]='1' then
Result:=Result+pow(2,length(BinStr)-counter);
end;
function DecodeSMS7Bit(PDU : string):string;
var OctetStr : string;
OctetBin : string;
Charbin : string;
PrevOctet: string;
Counter : integer;
Counter2 : integer;
begin
PrevOctet:='';
Result:='';
for Counter:=1 to length(PDU) do
begin
if length(PrevOctet)>=7 then { if 7 Bit overflow on previous }
begin
if BinStrToInt(PrevOctet)<>0 then
Result:=Result+Chr(BinStrToInt(PrevOctet))
else Result:=Result+' ';
PrevOctet:='';
end;
if Odd(Counter) then { only take two nibbles at a time }
begin
OctetStr:=Copy(PDU,Counter,2);
OctetBin:=HexToBin(OctetStr);
Charbin:='';
for Counter2:=1 to length(PrevOctet) do
Charbin:=Charbin+PrevOctet[Counter2];
for Counter2:=1 to 7-length(PrevOctet) do
Charbin:=OctetBin[8-Counter2+1]+Charbin;
if BinStrToInt(Charbin)<>0 then Result:=Result+Chr(BinStrToInt(CharBin))
else Result:=Result+' ';
PrevOctet:=Copy(OctetBin,1,length(PrevOctet)+1);
end;
end;
end;
function ReverseStr(SourceStr : string) : string;
var Counter : integer;
begin
Result:='';
for Counter:=1 to length(SourceStr) do
Result:=SourceStr[Counter]+Result;
end;
end.
[/php]