这个示例为 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。