support for 16-bit, 32-bit, and 64-bit DLL Projects

Author: ThomasJaeger

Domain/uGroup.pas

@@ -154,6 +154,22 @@ procedure TGroup.CreateNewProject(projectType: TProjectType; options: TVisualMAS
         project := CreateProject('MyLibrary.lib',projectType);
         project.CreateProjectFile('readme.txt', options, pftTXT);
       end;
+    ptWin32DLL:
+      begin
+        project := CreateProject('Win32.dll',projectType);
+        project.CreateProjectFile(WIN_DLL_MODULE_FILENAME, options, pftDef);
+        project.CreateProjectFile(DEFAULT_FILE_NAME, options);
+      end;
+    ptWin64DLL:
+      begin
+        project := CreateProject('Win64.dll',projectType);
+        project.CreateProjectFile(DEFAULT_FILE_NAME, options);
+      end;
+    ptWin16DLL:
+      begin
+        project := CreateProject('Win16.dll',projectType);
+        project.CreateProjectFile(DEFAULT_FILE_NAME, options);
+      end;
   end;
 
   AddProject(project);

Domain/uProject.pas

@@ -17,6 +17,8 @@   TProject = class(TVisualMASMFile)
       FOutputFile: string;
       FSizeInBytes: int64;
       FBuild: boolean;
+      FFunctions: TList<TFunctionData>;
+      FSavedFunctions: TList<TFunctionData>;
 
       FPreAssembleEventCommandLine: string;
       FAssembleEventCommandLine: string;
@@ -34,6 +36,7 @@   TProject = class(TVisualMASMFile)
       procedure SetProjectFile(Index: string; const Value: TProjectFile);
       procedure SetActiveFile(projectFile: TProjectFile);
       procedure SetSizeInBytes(value: int64);
+      function GetSavedFunction(f: string; fileId: string): string;
     public
       constructor Create; overload;
       constructor Create (Name: string); overload;
@@ -54,6 +57,13 @@   TProject = class(TVisualMASMFile)
       property OutputFile: string read FOutputFile write FOutputFile;
       property SizeInBytes: int64 read FSizeInBytes write SetSizeInBytes;
       property Build: boolean read FBuild write FBuild;
+      property Functions: TList<TFunctionData> read FFunctions write FFunctions;
+      property SavedFunctions: TList<TFunctionData> read FSavedFunctions write FSavedFunctions;
+      procedure ScanFunctions;
+      procedure ExportFunction(name: string; exportAs: string; fileId: string);
+      procedure MarkAllFunctionsNotToExport;
+      function WasFunctionExported(f: string; fileId: string): boolean;
+      procedure MarkAllFunctionsToExport;
     published
       procedure DeleteProjectFile(id: string);
       procedure AddProjectFile(projectFile: TProjectFile);
@@ -67,6 +77,8 @@ procedure TProject.Initialize;
 begin
   FProjectType := ptWin32;
   FProjectFiles := TDictionary<string, TProjectFile>.Create;
+  FFunctions := TList<TFunctionData>.Create;
+  FSavedFunctions := TList<TFunctionData>.Create;
   self.Modified := true;
   FBuild := true;
 end;
@@ -179,6 +191,23 @@ function TProject.CreateProjectFile(name: string; options: TVisualMASMOptions; f
         if fileType = pftTXT then
           projectFile.Content := TFile.ReadAllText(options.TemplatesFolder+LIB_STUB_FILENAME);
       end;
+    ptWin32DLL:
+      begin
+        if fileType = pftASM then
+          projectFile.Content := TFile.ReadAllText(options.TemplatesFolder+WIN_32_BIT_DLL_MASM32_FILENAME);
+        if fileType = pftDef then
+          projectFile.Content := TFile.ReadAllText(options.TemplatesFolder+WIN_DLL_DEF_FILENAME);
+      end;
+    ptWin64DLL:
+      begin
+        if fileType = pftASM then
+          projectFile.Content := TFile.ReadAllText(options.TemplatesFolder+WIN_64_BIT_DLL_MASM32_FILENAME);
+      end;
+    ptWin16DLL:
+      begin
+        if fileType = pftASM then
+          projectFile.Content := TFile.ReadAllText(options.TemplatesFolder+WIN_16_BIT_DLL_MASM32_FILENAME);
+      end;
   end;
 
   AddProjectFile(projectFile);
@@ -216,5 +245,122 @@ procedure TProject.SetSizeInBytes(value: int64);
   FSizeInBytes := value;
 end;
 
+procedure TProject.ScanFunctions;
+var
+  x,i,p: integer;
+  s: string;
+  functionData: TFunctionData;
+  comment: boolean;
+  pf: TProjectFile;
+  source: TStringList;
+begin
+  FFunctions.Clear;
+  source := TStringList.Create;
+  for pf in FProjectFiles.Values do
+  begin
+    source.Text := pf.Content;
+    for x := 0 to source.Count-1 do begin
+      p := pos(' PROC',Uppercase(source.Strings[x]));
+      if p > 0 then begin
+        s := trim(copy(source.Strings[x],0,p-1));
+        if (length(s)>0) then begin
+          comment := false;
+          for i := p downto 1 do begin
+            if s[i]=';' then begin
+              comment := true;
+              break;
+            end;
+          end;
+          if (s[1] <> ';') and (not comment) then begin
+            functionData.FileId := pf.Id;
+            functionData.Name := s;
+            functionData.ExportAs := GetSavedFunction(s, pf.Id);
+            functionData.Line := x+1;
+            functionData.FileName := ExtractFileName(pf.FileName);
+            functionData.Export := WasFunctionExported(s, pf.Id);
+            FFunctions.Add(functionData);
+          end;
+        end;
+      end;
+    end;
+  end;
+end;
+
+function TProject.GetSavedFunction(f: string; fileId: string): string;
+var
+  i: Integer;
+begin
+  result := f;
+  for i := 0 to FSavedFunctions.Count-1 do
+  begin
+    if (FSavedFunctions[i].FileId = fileId) and (FSavedFunctions[i].Name = f) then
+    begin
+      result := FSavedFunctions[i].ExportAs;
+      exit;
+    end;
+  end;
+end;
+
+function TProject.WasFunctionExported(f: string; fileId: string): boolean;
+var
+  i: Integer;
+begin
+  result := false;
+  for i := 0 to FSavedFunctions.Count-1 do
+  begin
+    if (FSavedFunctions[i].FileId = fileId) and (FSavedFunctions[i].Name = f) then
+    begin
+      result := true;
+      exit;
+    end;
+  end;
+end;
+
+procedure TProject.ExportFunction(name: string; exportAs: string; fileId: string);
+var
+  i: Integer;
+  fd: TFunctionData;
+begin
+  for i := 0 to FFunctions.Count-1 do
+  begin
+    if (FFunctions[i].FileId = fileId) and (FFunctions[i].Name = name) then
+    begin
+      fd := FFunctions[i];
+      fd.Export := true;
+      fd.ExportAs := exportAs;
+      FFunctions[i] := fd;
+      exit;
+    end;
+  end;
+end;
+
+procedure TProject.MarkAllFunctionsNotToExport;
+var
+  i: Integer;
+  fd: TFunctionData;
+begin
+  for i := 0 to FFunctions.Count-1 do
+  begin
+    fd := FFunctions[i];
+    fd.Export := false;
+    FFunctions[i] := fd;
+  end;
+end;
+
+procedure TProject.MarkAllFunctionsToExport;
+var
+  i: Integer;
+  fd: TFunctionData;
+begin
+  FSavedFunctions.Clear;
+  for i := 0 to FFunctions.Count-1 do
+  begin
+    fd := FFunctions[i];
+    fd.Export := true;
+    FFunctions[i] := fd;
+    FSavedFunctions.Add(fd);
+  end;
+end;
+
 
 end.

Domain/uProjectFile.pas

@@ -148,6 +148,8 @@ procedure TProjectFile.SetFileName(value: string);
     FProjectFileType := pftDLG
   else if fileExt = '.LIB' then
     FProjectFileType := pftLib
+  else if fileExt = '.DEF' then
+    FProjectFileType := pftDef
   else
     // FProjectFileType := pftOther;
     FProjectFileType := pftBinary;

Domain/uSharedGlobals.pas

@@ -64,12 +64,19 @@ interface
   COMPONENT_PALETTE_STANDARD: string = 'Standard';
   COMPONENT_PALETTE_WIN32: string = 'Win32';
   DEBUGGER_OUTPUT_FILE: string = '$OutputFile';
+  PROJECT_NAME: string = '$ProjectName';
+  EXPORTED_FUNCTIONS: string = '$ExportedFunctions';
   DOS_16_BIT_COM_STUB_FILENAME: string = 'MSDOS16COMHelloWorld.asm';
   DOS_16_BIT_EXE_STUB_FILENAME: string = 'MSDOS16EXEHelloWorld.asm';
   WIN_32_BIT_EXE_MASM32_FILENAME: string = 'Masm32HelloWorld.asm';
   WIN_32_BIT_DLG_MASM32_FILENAME: string = 'Win32HelloWorldDialog.asm';
   WIN_32_BIT_CON_MASM32_FILENAME: string = 'Win32HelloWorldConsole.asm';
   WIN_64_BIT_EXE_WINSDK64_FILENAME: string = 'WinSDK64HelloWorld.asm';
+  WIN_32_BIT_DLL_MASM32_FILENAME: string = 'Win32Dll.asm';
+  WIN_64_BIT_DLL_MASM32_FILENAME: string = 'Win64Dll.asm';
+  WIN_16_BIT_DLL_MASM32_FILENAME: string = 'Win16Dll.asm';
+  WIN_DLL_DEF_FILENAME: string = 'Dll.def';
+  WIN_DLL_MODULE_FILENAME: string = 'Module.def';
   LIB_STUB_FILENAME: string = 'LibraryReadMe.txt';
   TAB: string = #9;
   DEFAULT_PROJECTGROUP_NAME: string = 'ProjectGroup1';
@@ -171,9 +178,18 @@   TProjectData = record
 
   PFunctionData = ^TFunctionData;
   TFunctionData = record
+  private
+    FExport: boolean;
+    FExportAs: string;
+    procedure SetExport(Value: boolean);
+    procedure SetExportAs(Value: string);
+  public
     FileId: string;
     Name: string;
     Line: integer;
+    FileName: string;
+    property Export: boolean read FExport write SetExport;
+    property ExportAs: string read FExportAs write SetExportAs;
   end;
 
   PLabelData = ^TLabelData;
@@ -196,7 +212,7 @@   TGenericTreeData = record
     ptDos16EXE, ptWin16, ptWin16DLL, ptWin32Con, ptWin32Dlg, ptLib);
 
   TProjectFileType = (pftASM, pftRC, pftTXT, pftDLG, pftBAT, pftOther, pftINI,
-    pftCPP, pftINC, pftBinary, pftLib);
+    pftCPP, pftINC, pftBinary, pftLib, pftDef);
 
   TChange = (fcNone, fcCreate, fcUpdate, fcDelete);
 
@@ -231,6 +247,16 @@ implementation
 uses
   IdHashMessageDigest;
 
+procedure TFunctionData.SetExportAs(Value: string);
+begin
+  FExportAs := Value;
+end;
+
+procedure TFunctionData.SetExport(Value: boolean);
+begin
+  FExport := Value;
+end;
+
 function CreateResourceCodeBehind(name: string): string;
 begin
   result := '.386' + CRLF;
@@ -887,7 +913,7 @@ procedure RegisterFileType(fileType: TProjectFileType; OnlyForCurrentUser: boole
   case fileType of
     pftASM: FileExt := 'asm';
     pftRC: FileExt := 'rc';
-    pftTXT: ;
+    pftTXT,pftDef: ;
     pftDLG: ;
     pftBAT: ;
     pftOther: ;

Domain/uVisualMASMOptions.pas

@@ -111,14 +111,14 @@ procedure TVisualMASMOptions.Initialize;
   FContextHelpFontName := 'Tahoma';
   FContextHelpFontSize := 10;
   FOutputFontName := 'Courier New';
-  FOutputFontSize := 8;
+  FOutputFontSize := 10;
   FFunctionListFuncCol := 100;
   FFunctionListLabelCol := 40;
   FLabelsListFuncCol := 100;
   FLabelsListLabelCol := 40;
   FProjectExplorerNameCol := 100;
-  FProjectExplorerBuildCol := 50;
-  FProjectExplorerSizeCol := 50;
+  FProjectExplorerBuildCol := 80;
+  FProjectExplorerSizeCol := 100;
   FTheme := 'Auric';
   FDebugger := dtNone;
   FDebuggerFileName := '';
@@ -348,7 +348,7 @@ procedure TVisualMASMOptions.LoadFile;
   if FOutputFontName='' then
     FOutputFontName := 'Courier New';
   if FOutputFontSize<6 then
-    FOutputFontSize := 8;
+    FOutputFontSize := 10;
   frmMain.memOutput.Font.Name := FOutputFontName;
   frmMain.memOutput.Font.Size := FOutputFontSize;