home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / m / m003_1 / sdk_dos.ddi / TPASCAL / UNIT / LOADDRV.PAS next >
Encoding:
Pascal/Delphi Source File  |  1991-09-26  |  5.3 KB  |  127 lines
  1. { ------------------------------------------------------------------------ }
  2. {  @@ Usage                                                                }
  3. {                                                                          }
  4. {   function HeapFunc (Size: Word): Integer; far;                          }
  5. {                                                                          }
  6. {   DESCRIPTION:                                                           }
  7. {       Heap error function. It gets called whenever GetMem() fails.       }
  8. {       When GetMem() fails, this function returns 1 which causes          }
  9. {       GetMem() to return nil.                                            }
  10. {                                                                          }
  11. {       It is used to avoid run-time error when memory allocation fails.   }
  12. {                                                                          }
  13. {   ENTRY:                                                                 }
  14. {       Size :- This is the size of memory requested but could not be      }
  15. {               allocated.                                                 }
  16. {                                                                          }
  17. {   EXIT:                                                                  }
  18. {       returns 1 when GetMem() fails.                                     }
  19. {                                                                          }
  20. { ------------------------------------------------------------------------ }
  21.  
  22. function HeapFunc(Size: Word): Integer; far;
  23. begin
  24.     { if Size is 0, the return value will be ignored }
  25.     if Size > 0 then
  26.         HeapFunc := 1;
  27. end;
  28.  
  29.  
  30.  
  31. { ------------------------------------------------------------------------ }
  32. {  @@ Usage                                                                }
  33. {                                                                          }
  34. {   function LoadDriver (szDrvName : string) : pointer                     }
  35. {                                                                          }
  36. {   DESCRIPTION:                                                           }
  37. {       Loads driver into memory with the driver name specified. Upon      }
  38. {       return, the return pointer is pointed to the driver memory.        }
  39. {       The pointer is always adjusted to offset 0 to conform with the     }
  40. {       driver requirement. All the loadable drivers must be loaded to     }
  41. {       offset 0 of a segment.                                             }
  42. {                                                                          }
  43. {       The heap manager is used to check the status of memory allocation  }
  44. {       to avoid run-time error when memory allocation fails.              }
  45. {                                                                          }
  46. {   ENTRY:                                                                 }
  47. {       szDrvName :- Driver name to be loaded.                             }
  48. {                                                                          }
  49. {   EXIT:                                                                  }
  50. {       Pointer to the loaded driver.                                      }
  51. {                                                                          }
  52. { ------------------------------------------------------------------------ }
  53.  
  54. function LoadDriver (szDrvName : string) : pointer;
  55. type
  56.     PtrRec = record
  57.         lo, hi : word
  58.     end;
  59.  
  60. var
  61.     wTemp, wDrvSize: word;
  62.     lpPtr : pointer;
  63.     F : file;
  64.     szDrvFile : string;
  65.     sDrvInfo : SearchRec;
  66.  
  67. begin
  68.     { Install HeapError function }
  69.     HeapError := @HeapFunc;
  70.  
  71.     LoadDriver := nil;
  72.  
  73.     szDrvFile := GetEnv('SOUND');
  74.  
  75.     { search SOUND environment for driver }
  76.     if szDrvFile <> '' then begin
  77.         szDrvFile := szDrvFile + '\DRV\' + szDrvName;
  78.         FindFirst(szDrvFile, Archive, sDrvInfo);
  79.     end;
  80.  
  81.     { not found, search current directory for driver }
  82.     if DosError <> 0 then begin
  83.         szDrvFile := szDrvName;
  84.         FindFirst(szDrvFile, Archive, sDrvInfo);
  85.     end;
  86.  
  87.     if DosError = 0 then begin
  88.         {$I-}
  89.         Assign(F, szDrvFile);
  90.         Reset(F,1);
  91.         {$I+}
  92.  
  93.         if IOResult = 0 then begin
  94.             wDrvSize := word(FileSize(F));
  95.  
  96.             { allocate memory for driver + 15 bytes more for boundary adjust }
  97.             GetMem(lpPtr, wDrvSize + 15);
  98.  
  99.             { If successfully allocated memory }
  100.             if lpPtr <> nil then begin
  101.  
  102.                 { boundary adjust as driver need to be loaded at offset 0 }
  103.                 wTemp := PtrRec(lpPtr).hi + ((PtrRec(lpPtr).lo + 15) shr 4);
  104.                 lpPtr := pointer(Longint(wTemp) shl 16);
  105.  
  106.                 LoadDriver := lpPtr;
  107.                 BlockRead(F,lpPtr^,wDrvSize,wTemp);
  108.  
  109.                 if wDrvSize <> wTemp then begin
  110.                     LoadDriver := nil;
  111.                     writeln('Read file error ...');
  112.                 end;
  113.             end
  114.             else
  115.                 writeln('Memory allocation error ...');
  116.  
  117.             close(F);
  118.         end
  119.         else
  120.             writeln('Could not open ',szDrvName,'...');
  121.  
  122.     end
  123.     else
  124.         writeln('Driver file ',szDrvName,' does not exist ...');
  125. end;
  126.  
  127.