Delphi ActiveX

这个示例为 ASP 文件上传组件。

建立工程

工程类型“ActiveX Library”,建立了一个 ActiveX 库,Library 改名为 myobj。

添加“Active Server Object”,在 CoClassname 中填入 upfile,确定。

显示标题为 myobj_tlb 的类型库对话框,添加 5 个属性和一个方法。

编写代码

procedure Tupfile.OnEndPage;
begin
    inherited OnEndPage;
end;
procedure Tupfile.OnStartPage(const AScriptingContext: IUnknown);
var
    AOleVariant : OleVariant;
    tmpvar : OleVariant;
    contentlength : integer;
    i,DeliCount,pos1,pos2,lastpos : integer;
    FDelimeter : string;
begin
    inherited OnStartPage(AScriptingContext);
    FFormInfo := TStringList.Create;
    contentlength := Request.TotalBytes;
    AOleVariant := contentlength;
    tmpvar := Request.BinaryRead(AOleVariant);
    for i := 1 to contentlength -1 do
    begin
        FContentData := FContentData + chr(byte(tmpvar[i]));
    end;
    pos1 := pos(#13#10,FContentData);
    FDelimeter := copy(FContentData,1,pos1+1);
    DeliCount := length(FDelimeter);
    lastpos := 1;
    
    pos1:=0;
    while pos2>=pos1 do
    begin
        pos1 := instr(FDelimeter,FContentData,lastpos);
        if pos1 = 0 then Break;
        pos1 := pos1 + DeliCount;
        pos2 := instr(FDelimeter,FContentData,pos1)-1;
        AnalyFormData(copy(FContentData,pos1,pos2-pos1-1));
        lastpos := pos2;
    end;
    response.Write('upfile 初努化完成!');
end;
function Tupfile.Get_FileName: OleVariant;
begin
    Result := ExtractFileName(FFileName);
end;
function Tupfile.Get_FileSize: SYSINT;
begin
    Result := length(FFileData);
end;
procedure Tupfile.FileSaveAs(FileName: OleVariant);
var
    fsout:TFileStream;
begin
    fsout := TFileStream.Create(Filename,fmcreate);
    try
        fsout.Write(Byte(FFileData[1]),Length(FFileData))
    finally
        fsout.Free;
    end;
end;
function Tupfile.Get_FileData: OleVariant;
var
    i:integer;
begin
    Result := VarArrayCreate( [0,length(FFileData)], varByte );
    for i := 0 to length(FFileData)-1 do
    begin
        Result[i] := Byte(FFileData[i+1]);
    end;
end;
function Tupfile.Get_FileType: OleVariant;
begin

end;
function Tupfile.Get_Form(Form: OleVariant): OleVariant;
begin
    Result := FFormInfo.Values[Form];
end;
procedure Tupfile.AnalyFormData(content: string);
var
    pos1,pos2:integer;
    FormName,FormValue:string;
    isFile:boolean;
begin
    isFile := false;
    pos1 := instr('name="',content,1)+6;
    pos2 := instr('"',content,pos1);
    FormName := copy(content,pos1,pos2-pos1);
    //检查是否文件
    pos1 := instr('filename="',content,pos2+1);
    if pos1 <> 0 then
    begin
        isFile := true;
        pos1 := pos1 + 10;
        pos2 := instr('"',content,pos1);
        FFilename := copy(content,pos1,pos2-pos1);
    end;
    
    pos1 := instr(#13#10#13#10,content,pos2+1)+4;
    FormValue := copy(content,pos1,length(content)-pos1);
    
    if isfile then
    begin
        FFileData := FormValue;
        //查找文件类型信息
        pos2 := instr('Content-Type: ',content,pos2+1);
        if pos2 <> 0 then
        begin
            pos2 := pos2 + 14;
            FFileType := copy(content,pos2,pos1-4-pos2);
        end;
    end
    else
    begin
        FFormInfo.add(FormName+'='+FormValue);
    end;
end;
function Tupfile.instr(str1,str2:string;startpos:integer):integer;
var
    p1,p2,p3:pchar;
begin
    p1:=pchar(str1);
    p2:=pchar(str2);
    p2:=p2+startpos;
    
    p3:=strpos(p1,p2);
    if p3=nil then
        result:=-1
    else
        result:=p3-p2;
end;

编译并注册

选择 View-TypeLibrary-Registry Type Library。