Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/TCPExample/PNL Libraries/DNR.p

Text File | 1996-10-10 | 7.6 KB | 307 lines | [TEXT/CWIE]

unit DNR;

interface

    uses
        Types, TCPTypes;

    type
        ResultProcPtr = UniversalProcPtr;
{ procedure ResultProc(hip:hostInfoPtr; userdata:Ptr); }
        EnumResultProcPtr = UniversalProcPtr;
{ procedure EnumResultProc(cerp:cacheEntryRecordPtr; userdata:Ptr); }

    function OpenResolver: OSErr;
    procedure CloseResolver;
    function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
    procedure AddrToStr (addr: longint; var s: Str255);
    function EnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
    function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
    function HInfo (host: Str255; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
    function MXInfo (host: Str255; var mxi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;

implementation

    uses
        Resources, Errors, Memory, MixedMode, Files, Folders,
        MyCallProc, MyCStrings, MyMemory;

    const
        kOPENRESOLVER = 1;
        kCLOSERESOLVER = 2;
        kSTRTOADDR = 3;
        kADDRTOSTR = 4;
        kENUMCACHE = 5;
        kADDRTONAME = 6;
        kHINFO = 7;
        kMXINFO = 8;

    var
        code: Handle;

    procedure GetSystemFolder (var vrn: integer; var dirID: longint);
    begin
        if FindFolder(kOnSystemDisk, kSystemFolderType, false, vrn, dirID) <> noErr then begin
            vrn := 0;
            dirID := 0;
        end;
    end;

    procedure GetCPanelFolder (var vrn: integer; var dirID: longint);
    begin
        if FindFolder(kOnSystemDisk, kControlPanelFolderType, false, vrn, dirID) <> noErr then begin
            vrn := 0;
            dirID := 0;
        end;
    end;

{ SearchFolderForDNRP is called to search a folder for files that might }
{ contain the 'dnrp' resource }
    function SearchFolderForDNRP (ftype, fcreator: OSType; vrn: integer; dirID: longint): Handle;
        var
            pb: HParamBlockRec;
            filename: Str63;
            refnum: integer;
            i: integer;
            hhhh: Handle;
            err: OSErr;
    begin
        hhhh := nil;
        i := 1;
        repeat
            pb.ioNamePtr := @filename;
            pb.ioVRefNum := vrn;
            pb.ioDirID := dirID;
            pb.ioFDirIndex := i;
            i := i + 1;
            err := PBHGetFInfoSync(@pb);
            if err = noErr then begin
                if (pb.ioFlFndrInfo.fdType = ftype) & (pb.ioFlFndrInfo.fdCreator = fcreator) then begin
                    SetResLoad(false);
                    refnum := HOpenResFile(vrn, dirID, filename, fsRdPerm);
                    SetResLoad(true);
                    if refnum <> -1 then begin
                        hhhh := Get1IndResource('dnrp', 1);
                        if hhhh <> nil then begin
                            DetachResource(hhhh);
                        end;
                        CloseResFile(refnum);
                    end;
                end;
            end;
        until (err <> noErr) or (hhhh <> nil);
        SearchFolderForDNRP := hhhh;
    end;

    function SearchForDNRP: Handle;
        var
            hhhh: Handle;
            vrn: integer;
            dirID: longint;
    begin
{ first search Control Panels for MacTCP 1.1 }
        GetCPanelFolder(vrn, dirID);
        hhhh := SearchFolderForDNRP('cdev', 'ztcp', vrn, dirID);

        if hhhh = nil then begin
{ next search System Folder for MacTCP 1.0.x }
            GetSystemFolder(vrn, dirID);
            hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
        end;

        if hhhh = nil then begin
{ then search Control Panels for MacTCP 1.0.x }
            GetCPanelFolder(vrn, dirID);
            hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
        end;

        if hhhh = nil then begin
{ finally, look in any open resource file }
            hhhh := Get1IndResource('dnrp', 1);
            if hhhh <> nil then begin
                DetachResource(hhhh);
            end;
        end;

        SearchForDNRP := hhhh;
    end;

    function CallOpenResolver: OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC244ProcInfo);
        CallOpenResolver := CallC244(nil, kOPENRESOLVER,proc);
        DisposeRoutineDescriptor(proc);
    end;

    function OpenResolver: OSErr;
        var
            err: OSErr;
    begin
        code := SearchForDNRP;
        if code = nil then begin
            err := resNotFound;
        end else begin
            HLock(code);
            err := CallOpenResolver;
            if err <> noErr then begin
                MDisposeHandle(code);
            end;
        end;
        OpenResolver := err;
    end;

    function CallCloseResolver:OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC24ProcInfo);
        CallCloseResolver := CallC24(kCLOSERESOLVER,proc);
        DisposeRoutineDescriptor(proc);
    end;

    procedure CloseResolver;
        var
            junk:OSErr;
    begin
        if code <> nil then begin
            junk:=CallCloseResolver;
            MDisposeHandle(code);
        end;
    end;

    function CallStrToAddr (cname: CStringPtr; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC244444ProcInfo);
        CallStrToAddr := CallC244444(userdata,completion,@rtnStruct,cname,kSTRTOADDR,proc);
        DisposeRoutineDescriptor(proc);
    end;

    function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end else begin
            P2C(@host);
            err := CallStrToAddr(@host, rtnStruct, completion, userdata);
        end;
        StrToAddr := err;
    end;

    function CallAddrToStr(addr: longint; cstr: CStringPtr):OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC2444ProcInfo);
        CallAddrToStr := CallC2444(cstr, addr, kADDRTOSTR, proc);
        DisposeRoutineDescriptor(proc);
    end;

    procedure AddrToStr (addr: longint; var s: Str255);
        var
            junk:OSErr;
            len: integer;
    begin
        if code <> nil then begin
            junk := CallAddrToStr(addr, @s);
            len := 0;
            while (s[len] <> chr(0)) & (len < 255) do begin
                len := len + 1;
            end;
            BlockMoveData(@s, @s[1], len);
            s[0] := chr(len);
        end;
    end;

    function CallEnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC2444ProcInfo);
        CallEnumCache := CallC2444(userdata, completion, kENUMCACHE, proc);
        DisposeRoutineDescriptor(proc);
    end;

    function EnumCache (completion: EnumResultProcPtr; userdata: Ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end else begin
            err := CallEnumCache(completion, userdata);
        end;
        EnumCache := err;
    end;

    function CallAddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC244444ProcInfo);
        CallAddrToName := CallC244444(userdata, completion, @hi, addr, kADDRTONAME, proc);
        DisposeRoutineDescriptor(proc);
    end;

    function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end else begin
            err := CallAddrToName(addr, hi, completion, userdata);
        end;
        AddrToName := err;
    end;

    function CallHInfo (name: CStringPtr; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC244444ProcInfo);
        CallHInfo := CallC244444(userdata, completion, @hi, name, kHINFO, proc);
        DisposeRoutineDescriptor(proc);
    end;

    function HInfo (host: Str255; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end else begin
            P2C(@host);
            err := CallHInfo(@host, hi, completion, userdata);
        end;
        HInfo := err;
    end;

    function CallMXInfo (name: CStringPtr; var hi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            proc:UniversalProcPtr;
    begin
        proc:=New68kProc(code^,uppC244444ProcInfo);
        CallMXInfo := CallC244444(userdata, completion, @hi, name, kMXINFO, proc);
        DisposeRoutineDescriptor(proc);
    end;

    function MXInfo (host: Str255; var mxi: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
        var
            err: OSErr;
    begin
        if code = nil then begin
            err := notOpenErr;
        end else begin
            P2C(@host);
            err := CallMXInfo(@host, mxi, completion, userdata);
        end;
        MXInfo := err;
    end;

end.