收集ACTIVEX DLL代码!!哪们有好的代码，能不能贡献出来，让大家学习学习!!贴着有分!

Question

那位有关于ACTIVEX DLL的原代码，和调用它的代码最好一起贴出来!!
让大家互相学习学习!!!

Answer 1

一个简单的打印代码：
procedure TClPrn.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IClPrnEvents;
  inherited EventSinkChanged(EventSink);
end;procedure TClPrn.Initialize;
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;function TClPrn.Get_Active: WordBool;
begin
  Result := Active;
end;function TClPrn.Get_AlignDisabled: WordBool;
begin
  Result := AlignDisabled;
end;function TClPrn.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;function TClPrn.Get_AutoSize: WordBool;
begin
  Result := AutoSize;
end;function TClPrn.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;function TClPrn.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;function TClPrn.Get_Color: OLE_COLOR;
begin
  Result := OLE_COLOR(Color);
end;function TClPrn.Get_Cursor: Smallint;
begin
  Result := Smallint(Cursor);
end;function TClPrn.Get_DoubleBuffered: WordBool;
begin
  Result := DoubleBuffered;
end;function TClPrn.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;function TClPrn.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;function TClPrn.Get_Font: IFontDisp;
begin
  GetOleFont(Font, Result);
end;function TClPrn.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;function TClPrn.Get_HelpKeyword: WideString;
begin
  Result := WideString(HelpKeyword);
end;function TClPrn.Get_HelpType: TxHelpType;
begin
  Result := Ord(HelpType);
end;function TClPrn.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;function TClPrn.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;function TClPrn.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;function TClPrn.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;function TClPrn.Get_Visible: WordBool;
begin
  Result := Visible;
end;function TClPrn.Get_VisibleDockClientCount: Integer;
begin
  Result := VisibleDockClientCount;
end;procedure TClPrn._Set_Font(var Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;procedure TClPrn.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;procedure TClPrn.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;procedure TClPrn.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;procedure TClPrn.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;procedure TClPrn.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;procedure TClPrn.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;procedure TClPrn.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;procedure TClPrn.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;procedure TClPrn.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;procedure TClPrn.Set_AutoSize(Value: WordBool);
begin
  AutoSize := Value;
end;procedure TClPrn.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;procedure TClPrn.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;procedure TClPrn.Set_Color(Value: OLE_COLOR);
begin
  Color := TColor(Value);
end;procedure TClPrn.Set_Cursor(Value: Smallint);
begin
  Cursor := TCursor(Value);
end;procedure TClPrn.Set_DoubleBuffered(Value: WordBool);
begin
  DoubleBuffered := Value;
end;procedure TClPrn.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;procedure TClPrn.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;procedure TClPrn.Set_Font(const Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;procedure TClPrn.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;procedure TClPrn.Set_HelpKeyword(const Value: WideString);
begin
  HelpKeyword := String(Value);
end;procedure TClPrn.Set_HelpType(Value: TxHelpType);
begin
  HelpType := THelpType(Value);
end;procedure TClPrn.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;procedure TClPrn.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;procedure TClPrn.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;procedure TClPrn.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;procedure TClPrn.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;procedure TClPrn.ClPrn(const Str: WideString);
var
  TmpStr,Temp : String;
  Sub : Integer;
begin
  QRLabel_Year.Caption := copy(FormatDateTime('yyyymmdd',Now),1,4) + '年'
                        + copy(FormatDateTime('yyyymmdd',Now),5,2) + '月'
                        + copy(FormatDateTime('yyyymmdd',Now),7,2) + '日';
  ListBox1.Items.Clear;
  TmpStr := Str;
  if TmpStr <> '' then
  begin
    Sub := pos('&',TmpStr);
    while Sub > 0 do
    begin
      Temp := copy(TmpStr,1,Sub-1);
      ListBox1.Items.Add(Temp);
      TmpStr := copy(TmpStr,Sub + 1,Length(TmpStr)-Sub);
      Sub := pos('&',TmpStr);
    end;
    if TmpStr <> '' then
    begin
      ListBox1.Items.Add(TmpStr);
    end;
    while ListBox1.Items.Count < 30 do
    begin
      ListBox1.Items.Add(' ');
    end;
    QRLabel_Cx.Caption := ListBox1.Items[0];
    QRLabel_Sj.Caption := ListBox1.Items[1];
    QRLabel_Ddzb.Caption := ListBox1.Items[2];
    QRLabel_Ycr.Caption := ListBox1.Items[3];
    QRLabel_Dw.Caption := ListBox1.Items[4];
    QRLabel_Bddd.Caption := ListBox1.Items[5];
    QRLabel_Kw.Caption := ListBox1.Items[6];
    QRLabel_Cchour.Caption := ListBox1.Items[7];
    QRLabel_Fhhour.Caption := ListBox1.Items[8];
    QRLabel_Ccbs.Caption := ListBox1.Items[9];
    QRLabel_Fhbs.Caption := ListBox1.Items[10];
    QRLabel_Xslc.Caption := ListBox1.Items[11];
    QRRichText_Ddsx.Lines.Add(ListBox1.Items[12]);
    QRRichText_Bz.Lines.Add(ListBox1.Items[13]);
    QRRichText_Jycs.Lines.Add(ListBox1.Items[14]);
    QRRichText_Qz.Lines.Add(ListBox1.Items[15]);
  end
  else
  begin
    Application.MessageBox('读取数值错误，请重新录入','错误!',mb_ok+mb_iconstop);
    Exit;
  end;
  try
    QuickRep_Print.Print;
  except
    Application.MessageBox('打印出错！','错误提示!',mb_ok+mb_iconstop);
  end;
end;initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TClPrn,
    Class_ClPrn,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.

Answer 2

谢谢fhuibo(Sailor)的代码!!希望大家继续1!!!

Answer 3

转贴开发ASP分页组件
　　第一步：新建一个Activex Library,命名为PadoPage,然后再新建一个Active Server Object Class，命名为AdoPage，即建立了一个名为AdoPage的ASP组件，文件命名为Adopage.pas。　　第二步：打开Type Library，新建一个方法Get_Page，然后在Get_Page加入一个参数Pconnandsgl，用于传递数据库连接语句和SQL语句，参数选择为BSTR类型。　　第三步：新建一个DataModule，放入Adoconnection组件和AdoQuery组件，将Data Module命名为AdoDataModule。由于新建立的组件中的方法Get_Page要从DataModule中取得数据，所以需在Adopage.pas的Uses子句中加入AdoDataModule，然后声明一个数据模块的变量fadodm,同时加入Initialize和Destroy这两个方法，以便在ASP组作中生成数据模块。Adopage.pas具体代码如下所示：unit Adopage;　　interface　　uses　　 ComObj, SysUtils, Classes, ActiveX, AspTlb, Pbasedata_TLB, StdVcl, AdoDataModule;　　 //将AdoDataModule加入USE子句　　type　　 T Adopage = class(TASPObject, Ibasedata)　　 private　　 fadodm:TAdoDataModuleform;　　 protected　　 procedure OnEndPage; safecall;　　 procedure OnStartPage(const AScriptingContext: IUnknown); safecall;　　 procedure get_page(const pconnandsql: WideString); safecall;　　 public　　 procedure initialize;override;　　 destructor destroy;override;　　 end;　　implementation　　uses ComServ,forms;　　destructor Tadopage.destroy;　　begin　　 inherited;　　 fadodm.Destroy;　　end;　　procedure Tadopage.initialize;　　begin　　 inherited;　　 fadodm:=tadodmform.Create(forms.application);　　end;　　第四步：建立通用的分页显示数据的方法get_page，具体代码如下：　　procedure Tadopage.get_page(const pconnandsql: WideString);　　var i,j,n:integer;　　connstr,sqlstr:widestring;　　rs:_recordset;　　cur_url:widestring;　　page_no:integer;　　begin　　//首先从传递过来的参数中分别取出连接串和SQL语句　　pconnandsql:=uppercase(pconnandsql); 　　i:=pos('CONNSTR',pconnandsql);　　j:=pos('SQLSTR',pconnandsql);　　if i=0 or j=0 then　　 begin　　 response.write('数据库连接串或SQL语句错误!');　　 abort;　　 end;　　for n:=I+8 to j-1 do　　 connstr:=connstr+pconnandsql[n];　　for n:=j+7 to length(pconnandsql) do　　 sqlstr:=sqlstr+pconnandsql[n]; 　　//将取得的连接串和SQL语句分别赋给ADOconnection和ADOQuery　　fadodm.adoconnection1.connstring:=connstr;　　fadodm.adoquery1.sql.add(sqlstr);　　//以下为打开数据库并进行分页的过程　　try　　 fadodm.adoquery1.open; 　　//打开数据库　　 rs:=fadodm.adoquery1.recordset;　　//取得当前打开页面的URL和页码　　 try　　 if request.servervariable['url'].count＞0 then　　 cur_url:= request.servervariable.item['url'];　　 if request.querystring['page_no'].count＞0 then　　 page_no:=request.querystring.item['page_no']　　 else　　 page_no:=1;　　 except　　 end;　　 rs.pagesize:=20; 　　//每页设为20行　　 rs.AbsolutePage:=page_no; 　　//页面定位　　 response.write('共'+inttostr(rs.pagecount)+'页& ');　　 response.write('第'+inttostr(page_no)+'页& ');　　//对每个页码建立超链接　　for i:=1 to rs.pagecount do　　response.write('＜a href="'+cur_url+'?page_no='+inttostr(i)+'"＞'　　+inttostr(i)+'＜/a＞');　　//数据记录按表格显示　　response.write('＜table＞');　　//取得表格标题　　response.write('＜tr＞');　　for I:=0 to fadodm.adoquery1.fields.count-1 do　　 response.write('＜td＞'+fadodm.adoquery1.fields[i].fieldname+'＜/td＞');　　response.write('＜/tr＞');　　j:=1　　with fadodm.adoquery1 do　　 while (not eof) and j＜=rs.pagesize do　　 begin　　 response.write('＜tr＞');　　//取得表格内容　　for i:=1 to fields.count do　　 response.write('＜td＞'+fields[i].asstring+'＜/td＞');　　 response.write('＜/tr＞');　　 next;　　 end;　　response.write('＜/table＞');　　fadodm.adoquery1.close;　　except　　response.write('数据出错啦！');　　 end;　　end;　　以上即为取得通用分页数据的过程，需要注意的是编译时部分函数会出错，只需在USES子句中加入sysutils、classes和adodb单元即可。　　
第五步：编译并注册adopage组件，即可在ASP代码中调用，调用示例如下：　　＜%　　dim webpageobj　　set webpageobj=server.createobject("padopage.adopage")　　webpageobj.get_page("conn=provider=SQLOLEDB.1;presist security info=false;　　user id=sa;initical catalog=sale_data;data source=(local),　　sqlstr=selectfrom customer")　　 %＞　　通过以上步骤，我们就顺利地利用Delphi开发出了具有分页功能的ASP组件了。