国产亚洲av片在线观看播放,日本中文一区二区三区亚洲 ,亚洲国产美女在线观看

TClientDataSet

konhon 优华 — Thu, 29 Mar 2007 10:57:00 GMT

http://www.openitpower.com/wenzhang/97/10846_1.html

　　与TTable、TQuery一��P��TClientDataSet也是从TDataSet�l�承下来的，它通常用于多层体系�l�构的客��L��。TClientDataSet最大的特点是它不依赖于BDE(Borland Database Engine)�Q�但它需要一个动态链接库的支持，�q�个动态链接库叫DBCLIENT.DLL。在客户端，也不需要用TDatabase构�g�Q�因为客��L��q�不直接�q�接数据库�?br />　　�׃��TClientDataSet是从TDataSet�l�承下来的，所以，它支持诸如编辑、搜索、浏览、纠错、过滤等功能。由于TClientDataSet在内存中建立了数据的本地副本�Q�上�q�操作的执行速度很快。也正是�׃��TClientDataSet�q�不直接�q�接数据库，因此�Q�客��L��序必��L��供获取数据的机制。在Delphi 4中，TClientDataSet有三�U�途径获取数据�Q?br />.从文件中存取数据�?br />.从本地的另一个数据集中获取数据�?br />.通过IProvider接口从远�E�数据库服务器获取数据�?br />　　在一个客��L��序中�Q�可以同时运用上�q�C��U�机制获取数据�?
11.1 ��览和编辑数�?/b>
　　和其他数据集构�g一��P��可以用标准的数据控�g昄��由TClientDataSet引入的数据集�Q�当�Ӟ��q�需要借助于TDataSource构�g�?br />　　�׃��TClientDataSet是从TDataSet�l�承下来的，所以，凡是其他数据集构件支持的功能�Q�TClientDataSet构�g也大致具备。不同的是，TClientDataSet能够在内存中建立数据的副本，因此�Q�TClientDataSet比其他数据集构�g增加了一些特�D�的功能�?br />11.1.1 ��览数据
　　可以用标准的数据控�g昄��由TClientDataSet引入的数据集。在�q�行期，可以调用诸如First、GotoKey、Last、Next和Prior�{�函数来��览数据�?br />　　TClientDataSet也支持书�{�֊�能，可以用书�{�来标记某条记录�Q�以后就可以方便地找到这条记录�?br />　　对于TTable、TQuery�{�数据集构�g来说�Q�只能读RecNo属性来判断当前记录的序受��对于TClientDataSet构�g来说�Q�还可以写RecNo属性，使某一序号的记录成为当前记录�?br />11.1.2 CanModify属�?/b>
　　TDataSet的CanModify属性用于判断数据集中的数据是否可以修改。CanModify属性本�w�是只读的，也就是说�Q�数据是否能够修改不取决于应用程序�?br />　　不过�Q�TClientDataSet构�g有其�Ҏ��性，因�ؓTClientDataSet已经把数据在内存中徏立了副本�Q�因此，应用�E�序可以军_��是否允许修改数据。如果不允许用户修改数据�Q�只要把ReadOnly属性设为True�Q�此�Ӟ��CanModify属性肯定返回False�?br />　　与其他数据集构�g不同�Q�修改TClientDataSet构�g的ReadOnly属性时�Q�不需要事先把Active属性设为True�?br />11.1.3 取消修改
　　TClientDataSet传输数据的基本单位称为数据包�Q�当前的数据包可以由Data属性来讉K��。不�q�，用户�Ҏ��据的修改�q�不直接反映到Data属性中�Q�而是临时写到一个日志即Delta属性中�Q�这样做的好处是以后随时可以取消修改�?br />　　不过�Q�这里要说明一点，��管用户的修改�ƈ没有反映到Data�Q�当用户在数据控件中看到的却是最��C��改的数据。如果一条记录被反复修改了多�ơ，用户看到的只是最新的数据�Q�但日志中却记蝲了多�ơ�?br />　　要取消上一�ơ的修改�Q�调用UndoLastChange函数。UndoLastChange需要传递一个布��类型的参数叫FollowChange�Q�如果FollowChange参数设�ؓTrue�Q�光标就�U�d��被恢复的记录上，如果FollowChange参数设�ؓFalse�Q�光标仍然在当前记录上�?br />　　ChangeCount属性返回日志中记蝲的修�Ҏ��数。如果一条记录被反复修改了多�ơ，每调用一�ơUndoLastChange能够逐��取消上一�ơ的修改�?br />　　UndoLastChange只能取消上一�ơ的修改�Q�如果想一下子取消所有的修改�Q�首先要选择一个记录，然后调用RevertRecord。RevertRecord��从日志中取消所有对当前记录的修攏V�?br />　　TClientDataSet�q�有一个SavePoint属性，它能把当前的�~�辑状态保存�v来，以后随时可以�q�回当时的状态。例如，可以�q�样保存当前的状态：
　　BeforeChanges := ClientDataSet1.SavePoint;
　　以后�Q�可以这��h��恢复当时的状态：
　　ClientDataSet1.SavePoint := BeforeChanges;
　　应用�E�序可以保存多处状态，可以恢复其中一个状态，不过�Q�一旦某个状态被恢复�Q�在其之后的状态就无效�?br />　　如果要一下子取消日志中记载的所有修改，可以调用CancelUpdates函数。CancelUpdates��把日志清空�Q�取消所有的修改�?br />　　如果LogChanges属性设为False�Q�用户对数据的修改就会直接反映到Data属性中�?
11.1.4 合�ƈ修改
　　要把日志中记载的修改合�ƈ到Data属性中�Q�有两种方式�Q�具体��用哪一�U�方式，取决于应用程序获取数据的机制。不�q�，不管是哪�U�机�Ӟ��合�ƈ后，日志自动被清�I��?br />　　对于一个从文�g中获取数据的�E�序来说�Q�只要调用MergeChangeLog函数�Q�就把日志中记蝲的修改合�q�到Data属性中。不用担心其他用户同时修改了数据�?br />　　对于一个从应用服务器获取数据的�E�序来说�Q�就不能调用MergeChangeLog来合�q�数据，而要调用ApplyUpdates函数�Q�ApplyUpdates会把日志中记载的修改传递给应用服务器，待应用服务器成功地把数据更新了数据库服务器后�Q�才会合�q�到Data属性中�?br />11.1.5 �U�错
　　TClientDataSet支持�U�错功能。一般情况下�Q�需要自己徏立纠错规则，以便对用戯��入的数据�q�行�U�错�?br />　　此外�Q�如果获得了IProvider接口的话�Q�还可以从远�E�服务器引入�U�错规则�?br />　　有时候，客户端可能需要暂时禁止纠错，因�ؓ客户端从应用服务器检索数据是分阶�D�进行的�Q�在所有的数据��索完毕之前，有些�U�错规则很可能会报错�?
要暂时禁止纠错，可以调用DisableConstraints�Q�要重新允许�U�错�Q�可以调用EnableConstraints函数。DisableConstraints和EnableConstraints实际上都是作用于一个内部的计数�?br />11.2 �?�?/b>
　　使用索引有这么几个好处：
.在数据集中定位记录比较快�?br />.能够在两个数据集之间建立Lookup或Master/Detail关系�?br />.可以对记录排序�?br />　　在多层体�pȝ��构中�Q�当客户�E�序从应用服务器��索数据时�Q�它同时获得了默认的索引。默认的索引叫DEFAULT_ORDER�Q�可以��用这个烦引排序，但不能修�Ҏ��删除�q�个索引�?br />　　除了默认的烦引外�Q�TClientDataSet�q�对日志中记载的记录自动建立了一个副索引叫CHANGEINDEX。与DEFAULT_ORDER一��P��不能修改或删除这个副索引�?br />　　另外�Q�还可以使用数据集中已徏立的其他索引�Q�或者自己徏立烦引�?br />11.2.1 创徏一个新的烦�?/b>
　　要创��Z��个新的烦引，可以调用AddIndex。AddIndex需要传递若�q�个参数�Q?br />　　一是Name参数�Q�用于指定烦引名。在�q�行期切换烦引时需要用到烦引的名称�?br />　　二是Fields参数�Q�它是一个字�W�串�Q�用于指定烦引中的字�D�名�Q�彼此之间用分号隔开�?br />　　三是Options参数�Q�用于设�|�烦引的选项�Q�包含ixDescending元素表示按降序排列，包含ixCaseInsensitive元素表示大小写不敏感�?br />　　四是DescFields参数�Q�它也是一个字�W�串�Q�用于指定若�q�个字段名，�q�些字段��按照降序排列�?br />　　五是CaseInsFields参数�Q�它的作用与DescFields参数�c�M��Q�包含在CaseInsFields参数中的字段��对大小写不敏感�?br />　　六是GroupingLevel参数�Q�用于指定分�l��别，其��g��能超�q�烦引中的字�D�|��?br />　下面的代码创��Z��一个烦引：
If Edit1.Text <> '' and ClientDataSet1.Fields.FindField(Edit1.Text) then
Begin
ClientDataSet1.AddIndex(Edit1.Text+'Index',Edit1.Text, 　
　 [ixCaseInsensitive],'','',0);
ClientDataSet1.IndexName := Edit1.Text + 'Index';
End;
��Z��避免创徏一个烦引，可以临时用IndexFieldNames属性来指定若干个字�D�，让数据集按这些字�D�|��序�?br />11.2.2 删除和切换烦�?/b>
　　要删除一个先前创建的索引�Q�可以调用DeleteIndex�q�指定要删除的烦引名�U�。注意：DEFAULT_ORDER和CHANGEINDEX不能删除�?br />　　如果建立了多个烦引，可以��L��选择其中的一个烦引，�q�就要用到IndexName属性�?br />11.2.3 用烦引把数据分组
　　选择了一个烦引后�Q�数据集��自动按其中的字�D�进行排序。这��P��临近的记录往往在关键字�D�上含有相同的倹{��例如，假设有一个表是这��L��Q?br />SalesRep　Customer　OrderNo　Amount
1　　　　　　1 　　　　5 　　　100
1　　　　　　1　　　　 2　　　 50
1　　　　　　2　　　　 3 　　　200
1 　　　　　2　　　　6　　　75
2　　　　　　1　　　　1　　　10
2　　　　　　3　　　　4　　　200
　　可以看出�Q�SalesRep字段的值有重复的。对于SalesRep字段的��gؓ1的来��_��Customer字段的��g��有重复的。这��是��_��可以按SalesRep字段分组�Q�进而再按Customer字段分组。显�Ӟ��q�里的分�l��别是不同的，按SalesRep字段建立的分�l�属于第一�U�，按Customer字段建立的分�l�属于第二��。实际上�Q�分�l��别取决于字段在烦引中的顺序�?br />　　TClientDataSet可以军_��是否按照分组�U�别来显�C��录的倹{��例如，也许想以下面�q�种形式昄��数据�Q?br />SalesRep　Customer　OrderNo　Amount
1　　　　　　1　　　　5　　　　100
　　　　　　　　　　　2　　　　50
　　　　　　 2　　　　3　　　　200
　　　　　　　　　　　6　　　　75
2　　　　　　1　　　　1　　　　10
2　　　　　　3　　　　4　　　　200
　　要判断当前记录某一�U�的什么位�|�，可以调用GetGroupState函数。GetGroupState函数需要传递一个参敎ͼ�用于指定分组�U�别�?br />11.3 �?��?�?�D?/b>
　　与其他数据集一��P��也可以在TClientDataSet建立的数据集中增加计��字�D�c��计��字�D늚�值是��Z��同一个记录中的其他字�D�计��出来的�?br />　　在其他数据集中，只要用户修改了数据或当前记录发生改变�Q�就会触发OnCalcFields事�g�Q�换句话��_��计算字段的值就被计��一�ơ�?br />　　TClientDataSet引入了“内部计��字�D�”的概念。与一般的计算字段不同的是�Q�内部计��字�D늚�值将随其他字�D늚��g��起存取，�q�样�Q�只有当用户修改了数据才会触发OnCalcFields事�g�Q�如果仅仅改变了当前记录�Q�不会触发OnCalcFields事�g。也��是��_��内部计算字段的值需要重新计��的��Z��大大减少�?br />　　在处理OnCalcFields事�g的句柄中�Q�首先要判断State属性。如果State属性返回dsInternalCalc�Q�此旉��要计��内部计��字�D늚�倹{��如果State属性返回dsCalcFields�Q�此旉��要计��一般的计算字段的倹{�?br />11.4 �l?�?�?/b>
　　TClientDataSet增加了统计的功能�Q�它可以��Z��分组自动计算��d��、��^均、计数、最大、最��倹{��当用户�~�辑数据�Ӟ��q�些�l�计��g��自动跟着变化�?br />11.4.1 指定�l�计方式
　　要指定怎样�q�行�l�计�Q�就要用到Aggregates属性。这个属性是一个TAggregates对象�Q�它用于��理一�l�TAggregate对象�?br />　　在设计期�Q�可以单击Aggregates属性边上的省略��h��钮打开如图11.1所�C?br />的编辑器�?br />　　�?1.1 ��理一�l�TAggregate对象
　　单击按钮可以增加一个TAggregate对象�Q�单��L��钮可以删减一个TAggregate对象�Q�单��L��钮可以把TAggregate对象前移�Q�单��L��钮可以把TAggregate对象后移�?br />　　可以用字�D늼�辑器专门创徏一个用于表辄��计值的字段�Q�该字段的类型必��L��“Aggregate”。Delphi 4会自动创��Z��个TAggregate对象�Q��ƈ加到Aggregates属性中。选择一个TAggregate对象�Q�Object Inpector��显�C��对象的属性�?br />　　其中�Q�Expression属性用于指定统计表辑ּ��Q�例如：
Sum(Field1)
　　也可以是比较复杂的表辑ּ��Q?br />Sum(Qty * Price) - Sum(AmountPaid)
　　在表辑ּ�中，可以使用下列�l�计�q�算�W�：
.Sum计算一�l�数据的��d��?br />.Avg计算一�l�数据的�q�_��倹{�?br />.Count计算一�l�数据中的非�I�值的个数�?br />.Min计算一�l�数据的最��倹{�?br />.Max计算一�l�数据的最大倹{�?br />　　除了上述几个�l�计�q�算�W�外�Q�还可以使用�q��o条�g中所能��用的�q�算�W�，但不能嵌套。在一个表辑ּ�中，可以混合出现几个�l�计值或帔R��Q�但不能混合出现�l�计值和字段�?br />　　Sum(Qty * Price){合法}
　　Max(Field1) - Max(Field2){合法}
　　Avg(DiscountRate) * 100{合法}
　　Min(Sum(Field1)){非法�Q�不能嵌套}
　　Count(Field1) - Field2{非法�Q�统计值和字段不能混合出现在一个表辑ּ�中}
11.4.2 指定分组
　　默认情况下，�l�计值是��Z��数据集中所有的记录计算出来的。不�q�，也可以针对一部分记录计算�l�计��|��q�就需要事先徏立分�l��?br />　　前面在介�l�烦引时已经提到分组的概��c��可以通过IndexName属性和GroupingLevel属性来选择使用哪个索引以及最大的分组�U�别�?br />　　例如�Q�假设有一个表是这��L��Q?br />SalesRep　Customer　OrderNo　Amount
1　　　　　　1 　　　　5 　　　100
1　　　　　　1　　　　 2　　　 50
1　　　　　　2　　　　 3 　　　200
1 　　　　　2　　　　6　　　75
2　　　　　　1　　　　1　　　10
2　　　　　　3　　　　4　　　200
　　如果要按SalesRep字段分组�Q��ƈ且指定其中的�W�一�U�，�E�序代码应当�q�样写：
Agg.Expression := 'Sum(Amount)';
Agg.IndexName := 'SalesCust';
Agg.GroupingLevel := 1;
Agg.AggregateName := 'Total for Rep';
11.4.3 怎样获取�l�计�?/b>
　　要获取统计��|��可以调用TAggregate对象的Value函数。如果统计值是��Z��数据集中所有的记录计算出来的，随时可以调用Value函数。如果统计值是��Z��分组计算出来的，必须保证当前记录正好位于该分�l�内。因此，在调用Value之前�Q�最好先调用GetGroupState函数看看当前记录是否位于该分�l�内�?br />　　要在数据控�g中显�C�统计��|��必须事先在字�D늼�辑器中创��Z��个永久字�D�对象，该字�D늚��c�d��必须是Aggregate�?br />11.5 �?�?�?/b>
　　通过Data属性可以访问客��L��序从应用服务器检索到的数据。程序示例如下：
Procedure TForm1.Button1Click(Sender: TObject);
Begin
ClientDataSet1.Data := ClientDataSet1.Provider.DataRequest(FilterEdit.Text);
End;
11.5.1 直接对Data属性赋�?/b>
　　前面讲过�Q�客��L��序既可以通过IProvider接口获取数据�Q�也可以从另一个数据集获取数据�Q�后者就是通过Data属性赋值的。程序示例如下：
　　ClientDataSet1.Data := ClientDataSet2.Data;
　　一旦Data被赋��|��可以用标准的数据控件显�C��些数据�?br />　　注意�Q�当从另一个数据集获取数据�Ӟ��另一个数据集的日志也��被复制�q�来�Q�但不包括原来的范围和过滤条件�?br />　　如果要从另一个基于BDE的数据集中获取数据，可以通过数据集构件的Provider属性，�E�序�C�Z��如下�Q?br />　　ClientDataSet1.Data := Table1.Provider.Data;
　　如果要从一个自定义的数据集获取数据�Q�首先要创徏一个��时的TProvider构�g�Q�然后设�|�其DataSet属性指定这个自定义的数据集。程序示例如下：
TempProvider := TDataSetProvider.Create(Form1);
TempProvider.DataSet := SourceDataSet;
ClientDataSet1.Data := TempProvider.Data;
TempProvider.Free;
11.5.2 在数据包中加入自定义的信�?/b>
　　可以把自定义的信息加到数据包中。当把数据保存到文�g或流中时�Q�这些自定义的信息也��保存到文�g或流中。如果把数据包直接赋值给另一个数据集的话�Q�这些自定义的信息也��被复制�?br />　　要把自定义的信息加到数据包中�Q�可以调用SetOptionalParam函数。要从数据包中检索自定义的信息，可以调用GetOptionalParam。程序示例如下：
Procedure TAppServer.Provider1UpdateData(Sender: TObject; DataSet: TClientDataSet);
var
WhenProvided: TDateTime;
Begin
WhenProvided := DataSet.GetOptionalParam('TimeProvided');
...
End;
11.5.3 克隆另一个数据集
　　调用TClientDataSet的CloneCursor函数可以获得一个数据集的完全相同的副本。它与直接通过Data属性赋值是有区别的�?br />　　区别之一�Q�数据在两个数据集之间是�׃�n的，修改其中一个将同时修改另一个�?br />　　区别之二�Q�除了数据外�Q�CloneCursor函数�q�复制了一些属性和事�g�Q�这取决于Reset和KeepSettings参数怎样讄��?br />　　　CloneCursor函数需要传递三个参敎ͼ�其中�Q�Source参数指定源数据集�Q�Reset参数和KeepSettings参数用于讄��除了数据外是否还要复制下列属性和事�g�Q�Filter、Filtered、FilterOptions、OnFilterRecord、IndexName、MasterSource、MasterFields、ReadOnly、RemoteServer、ProviderName、Provider�?br />　　如果Reset和KeepSettings参数都设为False�Q�源数据集的上述属性和事�g都将被复制给目标数据集。如果Reset参数设�ؓTrue�Q�目标数据集的上�q�属性和事�g都将被清�I�。如果Reset参数设�ؓFalse�Q�而KeepSettings参数设�ؓTrue�Q�目标数据集的上�q�属性和事�g不变�Q�不�q�，必须保证�q�些属性和事�g与克隆后的数据相宏V�?br />11.6 与应用服务器通讯
　　在多层体�pȝ��构中�Q�客��L��序通过IProvider接口与应用服务器交换数据。这一章介�l�怎样在客��L��获得IProvider接口、怎样向应用服务器传递参数、怎样向应用服务器��h��数据、怎样把用户对数据的修改写到数据库中�?br />11.6.1 怎样在客��L��获得IProvider接口
　　在单层应用程序以及工作在“公文包”模式下的多层应用程序中�Q�不需要用到IProvider接口。而在多层体系�l�构中，客户�E�序要与应用服务器交换数据，首先必须获得IProvider接口�Q�这��p��用到RemoteServer属性和ProviderName属性�?br />　　RemoteServer属性用于指定客��L��的MIDAS�q�接构�g。MIDAS�q�接构�g又称Data Broker�Q�用于徏立和�l�护与应用服务器的连接�?br />　　在设计期�Q�正��设�|�了RemoteServer属性后�Q�就可以在对象观察器中�ؓProviderName属性选择一个��|��实际上就是选择应用服务器上的一个TProvider构�g�?br />11.6.2 向应用服务器传递参�?/b>
　　客户�E�序可以向应用服务器传递参敎ͼ��q�些参数实际上是传递给应用服务器上的TQuery构�g或TStoredProc构�g。既可以在设计期也可以在�q�行期设�|�参数�?br />　　在设计期�Q�可以单击Params属性边上的省略��h��钮，打开一个如�?1.2所�C�的�~�辑器�?br />　　�?1.2 讄��参数
　　单击按钮可以增加一个参敎ͼ�单击按钮可以删减一个参敎ͼ�单击按钮可以把一个参数前�U�，单击按钮可以把一个参数后�U�R�?br />　　选择一个参敎ͼ�对象观察器将昄��该参�?TParam对象)的属性�?br />　　在运行期可以调用TParams的CreateParam函数来创��Z��个参数。例如，下面的代码创��Z��一个参数叫CustNo�Q�它的��用类型是ptInput�Q�数据类型是ftInteger�Q�它的��D��?05�?br />With ClientDataSet1.Params.CreateParam(ftInteger, 'CustNo', ptInput) Do
AsInteger := 605;
　　讄��好参��C��后，如果TClientDataset的Active属性是False�Q�只要把Active属性设为True�Q�这些参数将被自动传递给应用服务器。如果Active属性已�l��ؓTrue�Q�就要调用SendParams函数把参��C��递给应用服务器�?br />　　注意�Q�传递给应用服务器的参数必须与TQuery构�g或TStoredProc构�g的参数匹配，包括名称、数据类型和参数�c�d��?br />11.6.3 怎样向应用服务器��h��数据
　　TClientDataSet提供了两个属性和三个�Ҏ��Q�用于怎样向应用服务器��h��数据�Q?br />　　一是FetchOnDemand属性。如果这个属性设为True�Q�TClientDataSet会根据需要自动检索附加的数据包，例如BLOB字段的值或者嵌套表的内宏V��如果这个属性设为False�Q�程序需要显式地调用GetNextPacket才能获得�q�些附加的数据包�?br />　　二是PacketRecords属性，用于讄��一个数据包中最多可容纳的记录数�Q�设�?1表示一个数据包可以容纳数据集的所有记录�?br />　　三是GetNextPacket函数�Q�用于向应用服务器检索下一个数据包�Q��ƈ把检索到的数据包��d��到前一�ơ检索到的数据包的后面。这个函数返回实际检索到的记录数�?br />　　四是FetchBlobs�q�程�Q�用于从应用服务器检索BLOB字段的倹{��如果FetchOnDemand属性设为True�Q�就没必要调用FetchBlobs函数�?br />　　五是FetchDetails�q�程�Q�用于检索嵌套表中的数据。如果FetchOnDemand属性设为True�Q�就没必要调用FetchDetails函数�?br />11.6.4 更新数据�?/b>
　　在多层体�pȝ��构中�Q�用户在客户端修改了数据后，需要把最新的数据写到数据库中�Q�这��p��调用TClientDataSet的ApplyUpdates函数�?br />　　ApplyUpdates只需要传递一个参数叫MaxErrors�Q�用于指定一个整敎ͼ�当遇到无法更新的记录��过�q�个数时�Q�此�ơ更新就中止。如果MaxErrors参数设�ؓ0�Q�表�C�只要遇��C��个错误更新就中止�Q�客��L��的日志保持不变。如果MaxErrors参数设�ؓ-1�Q�当应用服务器发现有错误的记录，��尝试更��C��一个记录，�{�所有的记录都尝试过以后才返回�?br />　　ApplyUpdates会自动调用Reconcile函数�Q�进而调用应用服务器上的TProvider构�g的ApplyUpdates函数��L��新远�E�的数据库服务器。没有被DBMS服务器认可的记录通过Reconcile�q�回�l�客��L��Q�此时将在客��L��触发OnReconcileError事�g让您更正错误。最后，ApplyUpdates函数�q�回仍然没有被认可的记录数�?br />11.7 在文件中存取数据
　　要从文�g中读取数据，可以调用LoadFromFile函数。LoadFromFile函数需要传递一个参敎ͼ�用于指定文�g名。文件名应包含完整的路径。如果客��L��序��L��从一个固定的文�g中读取数据，可以讄��FileName属性指定一个文件名�Q�以后，当TClientDataSet引入的数据集打开�Ӟ��p��动从�q�个文�g中读取数据，不需要调用LoadFromFile�?br />　　要从��中��d��数据�Q�可以调用LoadFromStream。LoadFromStream需要传递一个参敎ͼ�用于指定一个流对象�?br />　　注意�Q�LoadFromFile(LoadFromStream)只能从先前用SaveToFile(SaveToStream)保存的文件中��d��数据�?br />　　要把数据保存到文件中�Q�可以调用SaveToFile函数。SaveToFile需要传递一个参敎ͼ�用于指定文�g名。如果指定的文�g已存在，文�g中的数据��被覆盖。如果客��L��序��L��把数据保存到一个固定的文�g中，可以讄��FileName属性指定一个文件名�Q�当TClientDataSet引入的数据集关闭�Ӟ��p��动把数据保存到这个文件中�Q�不需要调用SaveToFile�?br />　　要把数据保存到流中，可以调用SaveToStream。SaveToStream需要传递一个参敎ͼ�指定一个流对象�?br />　　注意�Q�当把数据保存到文�g或流中时�Q�日志中记蝲的修改仍然保留。这��P��当下�ơ调用LoadFromFile或LoadFromStream��d��数据�Ӟ��仍然可以恢复原来的数据�?

konhon 优华 2007-03-29 18:57 发表评论

[轉]物流信息�pȝ��开发手�?Delphi的三层开�?

konhon 优华 — Wed, 28 Mar 2007 10:07:00 GMT

�q�日�Q�呵呵，�q�篇文章是去�q�写的）用了两个月开发了一个物��信息系�l�，�q�个�pȝ��是两层、三层相�l�合�Q?/span>C/S�?/span>B/S相结合的�pȝ��。虽焉��于时间的紧张和�h手的原因�Q�系�l�规模不是很大，但是其中涉及的技术却很全面。在�q�个�?b>开发技术篇》中我们��讲解我在开发系�l�中遇到的技术问题及解决�Ҏ��Q�希望对大家有帮助。对于物��信息系�l�的分析设计问题�Q�我��在另一��文章《物��信息系�l�开发手记――系�l�构架篇》中讲解�?/span>

一�?/span>Midas的安全问题�?/span>
    Midas技术是Delphi中进行三层开发的首选技术，它不仅有�U?/span>DCOM/COM+(COM+技术是.NET技术的基础)的优点，而且也结合了Delphi的快速开发特性，可以快速开发出惌��的系�l�，其开发速度是用VC,PB�{�开�?/span>DCOM的数十倍，把程序员从烦杂的代码中解脱出来，从而将更多的精力投入到业务逻辑的设计中厅R�?/span>
    但是Midas技术的一个最令�h担忧的就是它的安全问题：
�q�端只要知道应用服务器的端口号即可访问到应用服务器，而一旦访问到应用服务器，TClientDataSet卛_��获得ProviderNames列表。一旦知道了ProviderNames列表�Q�这��q��当于��数据库暴露在外了�?/span>
关于可轻易获�?/span>ProviderNames列表的问题，我��用下面的�Ҏ��解决�Q?/span>
在服务器端定义一�?/span>
LoginMTS(const AUserId, APassword: WideString): WordBool;
�Ҏ��。初始状态下�Q�所有的DataSetProvider和数据集的连接断开。用户必��调�?/span>LoginMTS�q�传递用户名和密码，登陆成功才将DataSetProvider和数据集的连接打开。这样如果用户验证没有通过�Q�即使它获得�?/span>ProviderNames列表也没法调用接口中的方法对数据库进行操作�?/span>
二�?/span>Midas中主从表的实�?/span>
��M��表的应用在信息系�l�中应用很广。在两层开发中我们可以通过直接建立两个数据集之间�ؓ��M��关系来实��C��从表�Q�在三层中虽然我们仍然可以通过直接建立两个数据集之间�ؓ��M��关系来实��C��从表�Q�但是这样就要求把数据库中所有相关的数据行都下蝲到本圎ͼ�丧失了三层开发的优势。我在实际中使用下面的方法实现。这里我以实现入库单查询、添加、修攏V��删�?/span>(CRUD)��Z��来讲解：
�Q?/span>1�Q�新��Z��?/span>MTS Data Module�Q�命名�ؓTmtsStockInListBiz,增加如下�Ҏ��Q?/span>
    function QueryStockInListMasterById(const AId: WideString;
      var ADatas: OleVariant): WordBool; safecall;
    function QueryStockInListSlaveByMasterId(const AId: WideString;
      var ADatas: OleVariant): WordBool; safecall;
    procedure UpdataStockInListMaster(var ADatas: OleVariant); safecall;
    procedure UpdataStockInListSlave(var ADatas: OleVariant); safecall;
    function GenerateStockInListId: WideString; safecall;

QueryStockInListMasterById作用是根据入库单单号查询入库单的基本信息�Q�入库日期、负责�h�{�）�Q?/span>Aid为入库单单号�Q?/span>Adatas��回��|��其格式就�?/span>Midas的数据包�Q�可以将光��l?/span>ClientDatSet�?/span>Data属性�?/span>
QueryStockInListSlaveByMasterId作用是根据入库单单号查询入库单的详细信息�Q�商品条码，数量�Q?/span>
UpdataStockInListMaster是对入库单主表进行删除、添加、修�Ҏ��作。只要将ClientDataSet�?/span>Delta属性做��Z��递即可�?/span>
UpdataStockInListSlave是对入库单从表进行删除、添加、修�Ҏ��作�?/span>
GenerateStockInListId是��生一个唯一的入库单受��?/span>
下面是几个方法的代码�Q�都很简单，��׃��多解释了�Q�可以查�?/span>Delphi的帮助�?/span>
function TmtsStockInListBiz.QueryStockInListMasterById(
const AId: WideString; var ADatas: OleVariant): WordBool;
begin
result := false;
ADatas := null;
try
    cdsQuery.Close;
    cdsQuery.CommandText := 'select * from t_StockInListMaster where Id=:Id';
    cdsQuery.Params.ParamByName('Id').AsString := AId;
    cdsQuery.Open;
    if cdsQuery.RecordCount > 0 then
    begin
      result := true;
      ADatas := cdsQuery.Data;
    end;
finally
    cdsQuery.Close;
end;
end;

procedure TmtsStockInListBiz.UpdataStockInListMaster(
var ADatas: OleVariant);
var
eCount: Integer;
OwnerData: OleVariant;
begin
DCOMConStockInList.GetServer.AS_ApplyUpdates('dspStockInListMaster',
    ADatas, -1, eCount, OwnerData);
end;

function TmtsStockInListBiz.GenerateStockInListId: WideString;
var
LPrior: string;
i: Integer;
begin
cdsQuery.Close;
cdsQuery.CommandText := 'select top 1 id from t_StockInListMaster order by id desc';
cdsQuery.Open;
LPrior := cdsQuery.FieldByName('Id').AsString;
i := StrToIntDef(RightStr(LPrior,8),0);
Inc(i);
result := 'RK' + FormatFloat('00000000',i);
cdsQuery.Close;
end;

�Q?/span>2�Q�、新��Z��个应用程序，通过DCOMConnection�?/span>SocketConnection�{�连接到MTS�l��g�Q�然后就可以调用MTS的相应的�Ҏ��实现客户端功能了�?/span>
攑օ�cdsStockInListMaster�?/span>cdsStockInListSlave两个ClientDataSet控�g�Q�在控�g上点��d��键，选择�?/span>FieldsEditor”新��Z��服务器中的字�D�同��L��字段�Q�然后再�ơ在控�g上单��d��键，选择�?/span>CreateDataSet”，建立一个本地数据库�?/span>
�Q?/span>3�Q?/span>
�Ҏ��入库单号查询入库单的�Ҏ��实现�Q?/span>
procedure TFormStockInList.BtnFindClick(Sender: TObject);
var
v,vs: OleVariant;
begin
if SocketConStockInList.AppServer.QueryStockInListMasterById(Trim(LEdtId.Text), v) then
begin
    cdsStockInListMaster.Data := v;//昄��入库单主表（主要信息�Q?/span>

    if SocketConStockInList.AppServer.QueryStockInListSlaveByMasterId(Trim(LEdtId.Text), vs) then
      cdsStockInListSlave.Data := vs; ;//昄��入库单从表（明细信息�Q?/span>
end
else
    ShowMessage('此单不存在！');
end;
�Q?/span>4�Q�新建入库单的实�?/span>
procedure TFormStockInList.BtnNewClick(Sender: TObject);
var
LId: string;
begin
ClearCDSRecord;
cdsStockInListMaster.Open;
cdsStockInListMaster.Insert;
LId := SocketConStockInList.AppServer.GenerateStockInListId;
LEdtId.Text := LId;
cdsStockInListMaster.FieldByName('Id').AsString := LId;
cdsStockInListMaster.FieldByName('GenerateDate').AsDateTime := Now();
end;
�Q?/span>5�Q�提交功能的实现
procedure TFormStockInList.BtnPostClick(Sender: TObject);
var
LQuerymts: ImtsQueryObjDisp;
LBar: string;
begin
SetSocketConnectionConnect(SocketConQuery);
LQuerymts := ImtsQueryObjDisp(SocketConQuery.GetServer);

SocketConQuery.Close;

if cdsStockInListMaster.RecordCount > 0 then
    SocketConStockInList.AppServer.UpdataStockInListMaster(cdsStockInListMaster.Delta);
if cdsStockInListSlave.RecordCount > 0 then
SocketConStockInList.AppServer.UpdataStockInListSlave(cdsStockInListSlave.Delta);
end;
注：本文�?/span>ClientDataSet控�g的名�U�开头一般�ؓcds�?/span>TsocketConnection控�g的名�U�开头一般�ؓSocketCon�?/span>
三、动态设�|?/span>TsimpleObjectBroker的服务器列表
procedure SetSocketConnectionConnect(AValue: TSocketConnection);
procedure FillAppServerList(ABroker: TSimpleObjectBroker);
var
    sl: TStringList;
    i, n: Integer;
begin
    sl := TStringList.Create;
    从配�|�文件中��d��服务器列表，�q�保存到sl�?/span>;
    n := sl.Count - 1;
    ABroker.ServerData := null;
    for i := 0 to n do
    begin
      ABroker.Servers.Add;
      ABroker.Servers[i].ComputerName := sl.Strings[i]
   end;
    sl.Free;
end;
var
LBroker: TSimpleObjectBroker;
begin
LBroker := TSimpleObjectBroker.Create(nil);
    FillAppServerList(LBroker);
    AValue.ObjectBroker := LBroker;
    try
      AValue.Connected := true;
    except
      raise Exception.Create('应用服务器连接错误！');
    end;
    LBroker.Free;
end;

konhon 优华 2007-03-28 18:07 发表评论

konhon 优华 — Fri, 02 Dec 2005 01:21:00 GMT

一个在普通用户下讄��DNS的例�?/P>
unit uMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry;

type
_STARTUPINFOW = record
    cb: DWORD;
    lpReserved: LPWSTR;
    lpDesktop: LPWSTR;
    lpTitle: LPWSTR;
    dwX: DWORD;
    dwY: DWORD;
    dwXSize: DWORD;
    dwYSize: DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags: DWORD;
    wShowWindow: Word;
    cbReserved2: Word;
    lpReserved2: PByte;
    hStdInput: THandle;
    hStdOutput: THandle;
    hStdError: THandle;
end;
STARTUPINFOW = _STARTUPINFOW;

TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
    { Private declarations }
    procedure DoOperation(aCmd: string);
public
    { Public declarations }
end;

var
Form1: TForm1;

function CreateProcessWithLogonW(lpUserName, lpDomain, lpPassword: LPCWSTR;
dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR;
dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCWSTR;
const lpStartupInfo: STARTUPINFOW; var lpProcessInformation: PROCESS_INFORMATION): BOOL; stdcall;
external advapi32 Name 'CreateProcessWithLogonW'

implementation

{$R *.dfm}

procedure DelRegCache;
begin
with TRegistry.Create do
try
    RootKey := HKEY_CURRENT_USER;
    DeleteKey('Software\Microsoft\Internet Explorer\TypedURLs');
finally
    Free;
end;
end;

procedure TForm1.DoOperation(aCmd: string);
var
STARTUPINFO: StartupInfoW;
ProcessInfo: TProcessInformation;
AUser, ADomain, APass, AExe: WideString;
const
LOGON_WITH_PROFILE = $00000001;
LOGON_NETCREDENTIALS_ONLY = $00000002;
begin
Screen.Cursor := crHourGlass;
try
    FillChar(STARTUPINFO, SizeOf(StartupInfoW), #0);
    STARTUPINFO.cb := SizeOf(StartupInfoW);
    STARTUPINFO.dwFlags := STARTF_USESHOWWINDOW;
    STARTUPINFO.wShowWindow := SW_SHOW;
    AUser := 'administrator';
    APass := '123';
    ADomain := 'domain';
    AExe := aCmd;
    if not CreateProcessWithLogonW(PWideChar(AUser), PWideChar(ADomain),
      PWideChar(APass),
      LOGON_WITH_PROFILE, nil, PWideChar(AExe),
      NORMAL_PRIORITY_CLASS, nil, nil, STARTUPINFO, ProcessInfo) then
      RaiseLastOSError;
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
finally
    Screen.Cursor := crDefault;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DoOperation('netsh interface ip add dns "區域連線" 192.168.10.81 1');
DoOperation('netsh interface ip add dns "區域連線" 202.96.128.166 2');
Application.MessageBox('操作完成!', 'CrackNet', MB_OK + 64);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DelRegCache;
DoOperation('netsh interface ip set dns "區域連線" dhcp');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Hide;
Button2.Click;
end;

end.

konhon 优华 2005-12-02 09:21 发表评论

Delphi 中如何用另外一个用��L��w�䆾来运行一人程�?

konhon 优华 — Tue, 15 Nov 2005 00:15:00 GMT

如一个程序要有以下的命��o来运�?BR>runas /env /savecred /user:hhql "c:\qlnetbar\bc2\bc2"
我现在的问题是如何在Delphi中用代码来代�?runas /env /savecred /user:hhql 的功能，因�ؓ我要监视 c:\qlnetbar\bc2\bc2 的运行情况，所�?c:\qlnetbar\bc2\bc2 必须要由我用Delphi写的�E�序来运�?/P>
请高手指教。。。�?BR>

果你用XP�?000�Q�可以用下面的API�Q�CreateProcessWithLogonW
type
_STARTUPINFOW = record
    cb: DWORD;
    lpReserved: LPWSTR;
    lpDesktop: LPWSTR;
    lpTitle: LPWSTR;
    dwX: DWORD;
    dwY: DWORD;
    dwXSize: DWORD;
    dwYSize: DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags: DWORD;
    wShowWindow: Word;
    cbReserved2: Word;
    lpReserved2: PByte;
    hStdInput: THandle;
    hStdOutput: THandle;
    hStdError: THandle;
end;
STARTUPINFOW = _STARTUPINFOW;

function CreateProcessWithLogonW(lpUserName, lpDomain, lpPassword: LPCWSTR;
dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR;
dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCWSTR;
const lpStartupInfo: STARTUPINFOW; var lpProcessInformation: PROCESS_INFORMATION): BOOL; stdcall;
external advapi32 Name 'CreateProcessWithLogonW'

procedure TForm1.Button2Click(Sender: TObject);
var
STARTUPINFO: StartupInfoW;
ProcessInfo: TProcessInformation;
AUser, ADomain, APass, AExe: WideString;
const
LOGON_WITH_PROFILE = $00000001;
LOGON_NETCREDENTIALS_ONLY = $00000002;
begin
FillChar(STARTUPINFO, SizeOf(StartupInfoW), #0);
STARTUPINFO.cb := SizeOf(StartupInfoW);
STARTUPINFO.dwFlags := STARTF_USESHOWWINDOW;
STARTUPINFO.wShowWindow := SW_SHOW;
AUser := edtUser.Text;
ADomain := edtDomain.Text;
APass := edtPass.Text;
AExe := edtExe.Text;
if not CreateProcessWithLogonW(PWideChar(AUser), PWideChar(ADomain),
    PWideChar(APass),
    LOGON_WITH_PROFILE, nil, PWideChar(AExe),
    NORMAL_PRIORITY_CLASS, nil, nil, STARTUPINFO, ProcessInfo) then
    RaiseLastOSError;
end;

已经��试通过

代码修改了一下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

type
_STARTUPINFOW = record
    cb: DWORD;
    lpReserved: LPWSTR;
    lpDesktop: LPWSTR;
    lpTitle: LPWSTR;
    dwX: DWORD;
    dwY: DWORD;
    dwXSize: DWORD;
    dwYSize: DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags: DWORD;
    wShowWindow: Word;
    cbReserved2: Word;
    lpReserved2: PByte;
    hStdInput: THandle;
    hStdOutput: THandle;
    hStdError: THandle;
end;
STARTUPINFOW = _STARTUPINFOW;

function CreateProcessWithLogonW(lpUserName, lpDomain, lpPassword: LPCWSTR;
dwLogonFlags: DWORD; lpApplicationName: LPCWSTR; lpCommandLine: LPWSTR;
dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCWSTR;
const lpStartupInfo: STARTUPINFOW; var lpProcessInformation: PROCESS_INFORMATION): BOOL; stdcall;
external advapi32 Name 'CreateProcessWithLogonW'
var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
STARTUPINFO: StartupInfoW;
ProcessInfo: TProcessInformation;
AUser, ADomain, APass, AExe: WideString;
const
LOGON_WITH_PROFILE = $00000001;
LOGON_NETCREDENTIALS_ONLY = $00000002;
begin
FillChar(STARTUPINFO, SizeOf(StartupInfoW), #0);
STARTUPINFO.cb := SizeOf(StartupInfoW);
STARTUPINFO.dwFlags := STARTF_USESHOWWINDOW;
STARTUPINFO.wShowWindow := SW_SHOW;
AUser := 'pcmax';
//ADomain := edtDomain.Text;
APass := 'pcmax';
AExe := 'c:\windows\system32\mspaint.exe';
if not CreateProcessWithLogonW(PWideChar(AUser), PWideChar(ADomain),
    PWideChar(APass),
    LOGON_WITH_PROFILE, nil, PWideChar(AExe),
    NORMAL_PRIORITY_CLASS, nil, nil, STARTUPINFO, ProcessInfo) then
    RaiseLastOSError;
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
ShowMessage('over now');
end;

end.

�q�行上面的代码，点击button1��׃��以用户pcmax�q�行 c:\windows\system32\mspaint.exe。然后等待运行结束后弹出提示对话框�?/P>

konhon 优华 2005-11-15 08:15 发表评论

konhon 优华 — Sat, 12 Nov 2005 00:59:00 GMT
�?�?�?�?�?�?�?�?�?�?�?�Q?Windows�?�?�?�?�?�?�?�?�?�?�?�?
�?�?�?�?�?�?�?�?�?�?�?�?�Q?�?�?�?�?�?DrawIcon��?�?�?�?�?�?�?�?�?

procedure TForm1.FormClick(Sender: TObject);
var
winHWND, hCur: integer;
winDC: integer;
rect: TRect;
pt: TPoint;
fBitmap: TBitmap;
begin
hCur := GetCursor(); // 取得光标句柄
GetCursorPos(pt); // 取得光标位置
winHWND := GetDesktopWindow();
winDC := GetDC(winHWND);
GetWindowRect(winHWND, rect);
fBitmap := TBitmap.create;
try
    fBitmap.width := rect.right - rect.left;
    fBitmap.height := rect.bottom - rect.top;
    BitBlt(fBitmap.canvas.handle, 0, 0, fBitmap.width, fBitmap.height, winDC, 0, 0, SRCCOPY);
    DrawIcon(fBitmap.canvas.handle, pt.x, pt.y, hCur); // ��d��?BR>    ReleaseDC(winHWND, winDC);
    Image1.Picture.Bitmap.Assign(fBitmap);
finally
    fBitmap.Free;
end;
end;

konhon 优华 2005-11-12 08:59 发表评论

字符串与二进制数之间的互相�{�?

konhon 优华 — Wed, 02 Nov 2005 10:37:00 GMT
��一个字�W�串转�ؓ二进�Ӟ��再从二进制�{为原字符丌Ӏ?

把字�W�串(可含中文字符)转�ؓ二进制数的函�?ConvertStrToBin();把二�q�制数�{换�ؓ字符串的函数�Q�ConvertBinToStr()�?BR> 以下两个函数亦可以对包含有中文字�W�的字符串进行处�?逆�{时亦可正常�{��Z��文�?BR>Function ConvertStrToBin(Value : string):string;//把字�W�串转化��Z��q�制�?BR>var tempHex : string[2];
i : integer;
begin
Result := '';
if trim(Value) = '' then Exit;
tempHex := '';
for i := 1 to Length(Value) do
begin
tempHex := IntToHex(Ord(Value[i]),2);//每个字符转成两位十六�q�制�?BR> Result := Result + BinToHexEachOther(tempHex,False);//十六�q�制转成二进�?BR> end;
end;

Function ConvertBinToStr(Value : string):string; //把二�q�制数据转化为字�W�串
Var tempHex : string;
i, tempInt : integer;
begin
Result := '';
if trim(Value) = '' then Exit;
tempHex := BinToHexEachOther(Value,true);//二进制�{成十六进�?BR> i := 0;
Repeat
begin
i := i + 1;
tempInt := HexCharToInt(tempHex[i]);
i := i + 1;
tempInt := tempInt * 16 + HexCharToInt(tempHex[i]);
//以上��两位十六进制数转变��Z��个十�q�制�?BR> Result := Result + chr(TempInt); //转成ASCII�?BR> end;
Until i >= length(tempHex)
end;

上两个互逆的函数中要调用到的函数HexCharToInt()和BinToHexEachOther()如下�Q?BR>
function BinToHexEachOther(ValueA : string; Action : Boolean) : string;
//把二�q�制串�{换成十六�q�制串或相反
var
ValueArray1 : Array [0..15] of string[4];
ValueArray2 : Array [0..15] of char;
i : shortint;
begin
//数组初始�?BR> ValueArray1[0] := '0000'; ValueArray1[1] := '0001'; ValueArray1[2] := '0010';
ValueArray1[3] := '0011'; ValueArray1[4] := '0100'; ValueArray1[5] := '0101';
ValueArray1[6] := '0110'; ValueArray1[7] := '0111'; ValueArray1[8] := '1000';
ValueArray1[9] := '1001'; ValueArray1[10] := '1010'; ValueArray1[11] := '1011';
ValueArray1[12] := '1100'; ValueArray1[13] := '1101'; ValueArray1[14] := '1110';
ValueArray1[15] := '1111';
for i := 0 to 15 do
if i >= 10 then ValueArray2[i] := chr(65 + (i - 10))
else ValueArray2[i] := inttostr(i)[1];

Result := '';
if Action then
begin //二进制串转换成十六进制串
if (Length(ValueA) MOD 4 <> 0) then
ValueA := stringofchar('0',Length(ValueA) MOD 4) + ValueA;
while (Length(ValueA) >= 4) do
begin
for i := 0 to 15 do
if Copy(ValueA,1,4) = ValueArray1[i] then
Result := Result + ValueArray2[i];
ValueA := Copy(ValueA,5,Length(ValueA) - 4);
end;
end
else begin //十六�q�制串�{换成二进制串
while (Length(ValueA) >= 1) do
begin
for i := 0 to 15 do
if Copy(ValueA,1,1) = ValueArray2[i] then
Result := Result + ValueArray1[i];
ValueA := Copy(ValueA,2,Length(ValueA) - 1);
end;
end;
end;

function HexCharToInt(HexToken : char):Integer;
begin
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;

十六�q�制字串转十�q�制又一法：
procedure TForm1.BitBtn1Click(Sender: TObject);
var myint : integer;
begin
myint := StrToInt('$' + '3A'); // myint = 58
showmessage(inttostr(myint));
end;

konhon 优华 2005-11-02 18:37 发表评论

�a�置�pȝ��時間

konhon 优华 — Wed, 12 Oct 2005 05:49:00 GMT
function SetSystemtime(ATime: TDateTime): Boolean;
var
ADateTime: TSystemTime;
yy, mon, dd, hh, min, ss, ms: Word;
begin
decodedate(ATime, yy, mon, dd);
decodetime(ATime, hh, min, ss, ms);
with ADateTime do
begin
    wYear := yy;
    wMonth := mon;
    wDay := dd;
    wHour := hh;
    wMinute := min;
    wSecond := ss;
    wMilliseconds := ms;
end;
Result := SetLocalTime(ADateTime);
SendMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
end;

konhon 优华 2005-10-12 13:49 发表评论

按分隔符取字�W�串

konhon 优华 — Tue, 30 Aug 2005 00:21:00 GMT

function TForm1.ExtractString(const aString: string; const aSeparator: char; var aPos: Integer): string;
var
I: Integer;
begin
I := aPos;
while (I <= Length(aString)) and (aString[I] <> aSeparator) do Inc(I);
Result := Trim(Copy(aString, aPos, I - aPos));
if (I <= Length(aString)) and (aString[I] = aSeparator) then Inc(I);
aPos := I;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
lString, lSubString: string;
lPos, j: integer;
begin
lString := '023842394201342|343242423423|342342424|533423|2455';
lPos := 1;
j := 0;

while lPos <= Length(lString) do
begin
    lSubString := ExtractString(lString, '|', lPos);
    inc(j);
    if j = 2 then    // �W�二�?BR>      showmessage(lSubString);
end;
end;

konhon 优华 2005-08-30 08:21 发表评论

動態�a�定Menu快捷键的问题

konhon 优华 — Sat, 27 Aug 2005 02:29:00 GMT
MenuItem1.ShortCut := ShortCut(Word(VK_RIGHT), [ssCtrl])

konhon 优华 2005-08-27 10:29 发表评论

啟用��用要地連接

konhon 优华 — Fri, 26 Aug 2005 09:11:00 GMT

http://m.tkk7.com/Files/konhon/EnableNetCard.rar

在Delphi中选Project Import Type Library命��o�Q�在对话框中选Import Microsoft Shell Controls And Automation�c�d��库，点Install后，在Delphi的ActiveX控�g板上��多了TShellFolderItem�Q�TShellLinkObject�Q�TShellFolderView�Q�TShell�Q�TSearchCommand�{�几个组�?/P>
const
   discVerb = '��用(&B)';
   connVerb = '启用(&A)';

function TForm1.DisableEthernet(const EthName,State: String): Boolean;
var
cpFolder: Folder;
nwFolder: Folder;
nVerbs: FolderItemVerbs;
i,j,k: integer;
aItem: TListItem;
begin
result := false;
cpFolder := Form1.shell1.NameSpace(3);
if cpFolder <> nil then
begin
    for i := 0 to cpFolder.items.Count-1 do
    begin
      if cpFolder.Items.Item(i).Name = '�|�络和拨可��? then
      begin
        nwFolder := cpFolder.items.item(i).GetFolder as Folder;
        if nwFolder <> nil then
        begin
          for j :=0 to nwFolder.items.Count-1 do
          begin
            if nwFolder.Items.Item(j).Name = EthName then
            begin
              nVerbs := nwFolder.Items.Item(j).Verbs;
              for k := 0 to nVerbs.Count-1 do
             begin
                if nVerbs.Item(k).Name = State then
                begin
                  nVerbs.Item(k).DoIt;
                  aItem := Form1.lvLog.Items.Add;
                  aItem.Caption := FormatDateTime('yyyy-mm-dd hh:mm:ss',now);
                  aItem.SubItems.Add(EthName);
                  aItem.SubItems.Add(State);
                  Result := True;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
    if nwFolder = nil then
       showmessage('Network and Dial-up Connections not found');
end
else
    showmessage('control panel not found');

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DisableEthernet('本地�q�接',discVerb);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DisableEthernet('本地�q�接',connVerb);
end;

konhon 优华 2005-08-26 17:11 发表评论

向CGI提交數據

konhon 优华 — Fri, 26 Aug 2005 03:13:00 GMT
procedure TForm1.Button1Click(Sender: TObject);
var
lUrl: string;
lParams: TStrings;
lHtml: string;
begin
lUrl := 'http://snixxx.co.uk/cgi-bin/mt-comments.cgi';
lParams := TStringList.Create;
try
    lParams.Add('entry_id=1302');
    lParams.Add('author=dqxhyy');
    lParams.Add('dqxhyy@sina.com');
    lParams.Add('dqxhyydqxhyydqxhyydqxhyy');
    try
      lHtml := IdHttp1.Post(lUrl, lParams);
    except
      showmessage(lhtml);
    end;
    showmessage(lhtml);
finally
    lParams.Free;
end;
end;

konhon 优华 2005-08-26 11:13 发表评论

如何通过发送WM_COMMAND消息模拟点击其他�E�序�H�体上的菜单��?

konhon 优华 — Fri, 26 Aug 2005 02:05:00 GMT

procedure TForm1.Button1Click(Sender: TObject);
var
   h,m,s,s1:hwnd;
begin
h:=FindWindow('notepad',nil);
   if h<>0 then
   begin
     m:=GetMenu(h);
     s:=GetSubMenu(m,1);
     s1:=GetSubMenu(s,7);
     SendMessage(h,WM_COMMAND,MakeLong(GetMenuItemId(s,7),0),s1);
end;
end;

konhon 优华 2005-08-26 10:05 发表评论

konhon 优华 — Thu, 25 Aug 2005 11:58:00 GMT
procedure TForm1.Label1Click(Sender: TObject);
var
lPoint: TPoint;
begin
lPoint.X := TLabel(Sender).Left;
lPoint.Y := TLabel(Sender).Top + TLabel(Sender).Height;
lPoint:=ClientToScreen(lPoint);
PopupMenu1.Popup(lPoint.X, lPoint.Y);
end;

konhon 优华 2005-08-25 19:58 发表评论

DBGrid不夠寬加'...'

konhon 优华 — Thu, 25 Aug 2005 11:57:00 GMT
procedure TForm1.ADODataSet1MaterielNameGetText(Sender: TField;
var Text: string; DisplayText: Boolean);
var
lSingleWidth: integer;
lDBGridWidth: integer;
begin
lSingleWidth := DBGrid1.Canvas.TextWidth('�?);
lDBGridWidth := DBGrid1.Columns[1].Width;
if DBGrid1.Canvas.TextWidth(Sender.AsString) <= lDBGridWidth then
    Text := Sender.AsString
else if DBGrid1.Canvas.TextWidth(Sender.AsString) > lDBGridWidth then
begin
    lSingleWidth := lDBGridWidth div lSingleWidth - 1;
    if lSingleWidth mod 2 = 1 then
      lSingleWidth := lSingleWidth + 1;
    Text := Copy(Sender.AsString, 1, lSingleWidth) + '...';
end
end;

konhon 优华 2005-08-25 19:57 发表评论

如何得到鼠标�l�过listview每一行的各列信息

konhon 优华 — Thu, 25 Aug 2005 11:45:00 GMT

uses CommCtrl;

procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
item: TListItem;
lvhti: LV_HITTESTINFO;
begin
item := ListView1.GetItemAt(X, Y);
if (item <> nil) then
    Caption := 'Mouse at: ' + item.Caption
else
begin
    lvhti.pt.X := X;
    lvhti.pt.Y := Y;
    ListView_SubItemHitTest(ListView1.Handle, @lvhti);
    if Assigned(ListView1.Items[lvhti.iItem])
      and (ListView1.Items[lvhti.iItem].SubItems.Count >= lvhti.iSubItem) then
      Caption := 'Mouse at:' + ListView1.Items[lvhti.iItem].SubItems[lvhti.iSubItem - 1];
end;
end;

konhon 优华 2005-08-25 19:45 发表评论

国产亚洲av片在线观看播放,日本中文一区二区三区亚洲 ,亚洲国产美女在线观看

TClientDataSet

[轉]物流信息�pȝ��开发手�?Delphi的三层开�?

Delphi 中如何用另外一个用��L���w�䆾来运行一人程�?

字符串与二进制数之间的互相�{�?

�a�置�pȝ��時間

按分隔符取字�W�串

動態�a�定Menu快捷键的问题

啟用���用要地連接

向CGI提交數據

如何通过发送WM_COMMAND消息模拟点击其他�E�序�H�体上的菜单��?

DBGrid不夠寬加'...'

如何得到鼠标�l�过listview每一行的各列信息

Delphi 中如何用另外一个用��L��w�䆾来运行一人程�?

啟用��用要地連接