Pb2StaticLib - Create static libs

[chi]

Seems like you can create static libs with Purebasic after all.

Without going too much into detail about what you can or can't do or how to write a static lib, here is the source code:

Pb2StaticLib.pb

Code: Select all

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Pb2StaticLib (by chi) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;    v1.02 (2017.11.14) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EnableExplicit

Define title$ = "Pb2StaticLib v1.02 (by chi)"
Define file$, save$, pth$, obj$, asm$, lst$, prog, exit, outProg$, cLine$, IncludeNextLine, x, aLine$, prefix$, cnt, i, tmpLib$, outLib$, pos, ext$, objfile$, filelist$
Dim func.s(0)

If CountProgramParameters()=2
  pth$  = ProgramParameter(0) + "Compilers\"
  file$ = ProgramParameter(1)
Else
  pth$  = #PB_Compiler_Home + "Compilers\"
  file$ = OpenFileRequester("Choose a file to open...", "", "PureBasic (*.pb, *.pbi)|*.pb;*.pbi", 0)
EndIf

;OutputDebugString_(pth$)
;OutputDebugString_(file$)

If FileSize(file$) > 0
  
  save$ = SaveFileRequester("Save static lib as...", GetFilePart(file$, #PB_FileSystem_NoExtension) + ".lib", "Library (*.lib)|*.lib", 0)
  If save$ <> ""
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Init strings ;;;;;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      obj$ = GetFilePart(save$, #PB_FileSystem_NoExtension) + ".obj"
      asm$ = "PureBasic.asm"
      lst$ = "objlist.txt"
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Create ASM, DEF, ... ;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      prog = RunProgram(pth$ + "pbcompiler.exe", "/commented /dll " + Chr(34) + file$ + Chr(34), pth$, #PB_Program_Hide|#PB_Program_Open|#PB_Program_Read)
      If prog
        While ProgramRunning(prog)
          If AvailableProgramOutput(prog)
            outProg$ + ReadProgramString(prog) + Chr(13)
          EndIf
        Wend
        exit = ProgramExitCode(prog)
        CloseProgram(prog)
        If exit <> 0
          outProg$ + Chr(13) + "[ErrorCode: " + Str(exit) + "] Please fix the error(s) and run the program again..."
          MessageRequester("pbcompiler.exe", outProg$, #PB_MessageRequester_Error)
          Goto theEnd
        EndIf
        outProg$ = ""
      Else
        MessageRequester("pbcompiler.exe", "Oops, something went wrong...", #PB_MessageRequester_Error)
        Goto theEnd
      EndIf
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Rewrite ASM ;;;;;;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      If ReadFile(0, pth$ + asm$)
        While Eof(0) = 0
          cLine$ = ReadString(0)
          If FindString(cLine$, "; ProcedureDLL") Or IncludeNextLine
            If FindString(cLine$, " AttachProcess(", 1, #PB_String_NoCase) > 0 : Continue : EndIf
            If FindString(cLine$, " DetachProcess(", 1, #PB_String_NoCase) > 0 : Continue : EndIf
            If FindString(cLine$, " AttachThread(", 1, #PB_String_NoCase) > 0 : Continue : EndIf
            If FindString(cLine$, " DetachThread(", 1, #PB_String_NoCase) > 0 : Continue : EndIf
            ReDim func(x)
            If IncludeNextLine
              func(x) = StringField(cLine$, 1, ":")
            Else
              func(x) = Mid(cLine$, 15)
            EndIf
            x + 1
            IncludeNextLine = IncludeNextLine ! 1
          EndIf
          aLine$ + cLine$ + Chr(13)
        Wend
        CloseFile(0)
        CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
          prefix$ = "_"
        CompilerEndIf
        cnt = ArraySize(func())-1
        For i=0 To cnt
          aLine$ = ReplaceString(aLine$, func(i+1), prefix$ + StringField(StringField(func(i), 2, " "), 1, "("))
          If i % 2 = 0
            tmpLib$ = Trim(func(i))
            If Left(tmpLib$, 1) = "."
              ext$ = StringField(tmpLib$, 1, " ")
              tmpLib$ = RemoveString(tmpLib$, ext$, #PB_String_CaseSensitive, 1, 1)
              If ext$ <> ".s"
                pos = FindString(tmpLib$, "(")
                tmpLib$ = InsertString(tmpLib$, ext$, pos)
              EndIf
            EndIf
            outLib$ + Chr(9) + Trim(tmpLib$) + Chr(13)
          EndIf
        Next
        outLib$ = "Import " + Chr(34) + GetFilePart(save$) + Chr(34) + Chr(13) + outLib$ + "EndImport"
        FreeArray(func())
        DeleteFile(pth$ + asm$)
        If OpenFile(0, pth$ + asm$)
          WriteString(0, aLine$)
          CloseFile(0)
        EndIf
        If MessageRequester(title$, "If you want to edit the ASM file, now would be a pretty good time..." + Chr(13) + Chr(13) + "Would you like to open it?", #PB_MessageRequester_YesNo|#PB_MessageRequester_Info) = #PB_MessageRequester_Yes
          RunProgram(asm$)
          MessageRequester(title$, "Click OK when you're done editing...", #PB_MessageRequester_Info)
        EndIf
      Else
        MessageRequester("Rewrite ASM", "Oops, something went wrong...", #PB_MessageRequester_Error)
        Goto theEnd
      EndIf
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Create OBJ ;;;;;;;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      prog = RunProgram(pth$ + "fasm.exe", Chr(34) + asm$ + Chr(34) + " " + Chr(34) + obj$ + Chr(34), pth$, #PB_Program_Hide|#PB_Program_Open|#PB_Program_Read)
      If prog
        While ProgramRunning(prog)
          If AvailableProgramOutput(prog)
            outProg$ + ReadProgramString(prog) + Chr(13)
          EndIf
        Wend
        exit = ProgramExitCode(prog)
        CloseProgram(prog)
        If exit <> 0
          outProg$ + Chr(13) + "[ErrorCode: " + Str(exit) + "] Please fix the error(s) and run the program again..."
          MessageRequester("fasm.exe", outProg$, #PB_MessageRequester_Error)
          Goto theEnd
        EndIf
        outProg$ = ""
      Else
        MessageRequester("fasm.exe", "Oops, something went wrong...", #PB_MessageRequester_Error)
        Goto theEnd
      EndIf
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Create OBJ List ;;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      If MessageRequester(title$, "Would you like to add additional files (.obj, .lib or .dll) to the library?", #PB_MessageRequester_YesNo|#PB_MessageRequester_Info) = #PB_MessageRequester_Yes
        objfile$ = OpenFileRequester(title$, "", "Object (*.obj)|*.obj|Library (*.lib)|*.lib|DLL (*.dll)|*.dll|All files (*.*)|*.*", 0, #PB_Requester_MultiSelection)
        If objfile$ <> ""
          While objfile$
            CopyFile(objfile$, pth$ + GetFilePart(objfile$))
            filelist$ + GetFilePart(objfile$) + Chr(13)
            objfile$ = NextSelectedFileName()
          Wend
        EndIf
      EndIf
      If OpenFile(0, pth$ + lst$)
        WriteStringN(0, obj$)
        WriteStringN(0, filelist$)
        CloseFile(0)
      Else
        MessageRequester("OBJ List", "Oops, something went wrong...", #PB_MessageRequester_Error)
        Goto theEnd
      EndIf
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Create LIB ;;;;;;;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      prog = RunProgram(pth$ + "polib.exe", "/out:" + Chr(34) + save$ + Chr(34) + " @" + lst$, pth$, #PB_Program_Hide|#PB_Program_Open|#PB_Program_Read)
      If prog
        While ProgramRunning(prog)
          If AvailableProgramOutput(prog)
            outProg$ + ReadProgramString(prog) + Chr(13)
          EndIf
        Wend
        exit = ProgramExitCode(prog)
        CloseProgram(prog)
        If exit <> 0
          outProg$ + Chr(13) + "[ErrorCode: " + Str(exit) + "] Please fix the error(s) and run the program again..."
          MessageRequester("polib.exe", outProg$, #PB_MessageRequester_Error)
          Goto theEnd
        EndIf
        outProg$ = ""
      Else
        MessageRequester("polib.exe", "Oops, something went wrong...", #PB_MessageRequester_Error)
        Goto theEnd
      EndIf
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; Clipboard window ;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      If OpenWindow(0, 602, 311, 340, 260, title$, #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
        StringGadget(0, 5, 5, 305, 20, save$, #PB_String_ReadOnly)
        ButtonGadget(1, 315, 5, 20, 20, "...")
        EditorGadget(2, 5, 30, 330, 190, #PB_Editor_ReadOnly)
        ButtonGadget(3, 150, 225, 110, 30, "Copy to Clipboard", #PB_Button_Default)
        ButtonGadget(4, 265, 225, 70, 30, "Close")
        TextGadget(5, 5, 233, 140, 15, "Work is done!", #PB_Text_Center)
        SetGadgetText(2, outLib$)
        SetActiveGadget(3)
        Repeat
          Define Event = WaitWindowEvent()
          Select Event
            Case #PB_Event_Gadget
              Select EventGadget()
                Case 1
                  RunProgram(GetPathPart(save$))
                Case 3
                  SetClipboardText(outLib$)
                Case 4
                  event = #PB_Event_CloseWindow
              EndSelect
          EndSelect
        Until Event = #PB_Event_CloseWindow
      EndIf
      
    ;}
    
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;;; CleanUp and End ;;;;;;;;;;;;;;
    ;{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      
      theEnd:
      DeleteFile(pth$ + obj$)
      DeleteFile(pth$ + asm$)
      DeleteFile(pth$ + lst$)
      DeleteFile(pth$ + "PureBasic.def")
      DeleteFile(pth$ + "PureBasic.dll")
      DeleteFile(pth$ + "PureBasic.exp")
      DeleteFile(pth$ + "PureBasic.lib")
      If filelist$ <> ""
        cnt = CountString(filelist$, Chr(13))
        For i=0 To cnt
          DeleteFile(pth$ + StringField(filelist$, i+1, Chr(13)))
        Next
      EndIf
      
    ;}
    
  EndIf
  
EndIf

Example Dll

Code: Select all

ProcedureDLL.d chi_mul(a.d, b.d)
  ProcedureReturn a*b
EndProcedure

ProcedureDLL.d chi_div(a.d, b.d)
  ProcedureReturn a/b
EndProcedure

ProcedureDLL.s chi_txt(txt$)
  ProcedureReturn "You wrote: " + txt$
EndProcedure

Example App

Code: Select all

Import "chi.lib"
	chi_txt(txt$)
	chi_div.d(a.d, b.d)
	chi_mul.d(a.d, b.d)
EndImport

MessageRequester("Info", StrD(chi_mul(3.5, 3)) + Chr(13) + StrD(chi_div(40, 2.8)) + Chr(13) + PeekS(chi_txt("chi")))

[chi]

With a little trick you can also use PB internal functions... (but they are bound to the ~same PB version)

Example Dll

Code: Select all

ProcedureDLL chi_win()
  OpenWindow(0, 0, 0, 480, 300, "Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
  ButtonGadget(0, 10, 10, 100, 30, "Info")
  HideWindow(0, #False)
  Repeat
    event = WaitWindowEvent()
    Select event
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            MessageRequester("Info", "Window + MessageRequester from a static lib...", #PB_MessageRequester_Info)
        EndSelect
    EndSelect
  Until event = #PB_Event_CloseWindow
EndProcedure

Example App

Code: Select all

If 0
  MessageRequester("", "")
  OpenWindow(0,0,0,0,0,"")
EndIf

Import "chi.lib"
	chi_win()
EndImport

chi_win()

[gurj]

thanks,but text bug:

Code: Select all

Import "D:\exe1\PureB\lib\lib-test.lib"
	chi_txt(txt$)
	chi_mul.d(a.d, b.d)
	chi_div.d(a.d, b.d)
EndImport
txt$="kjhg ff"
a.d=7.9
b.d=2.5
Debug chi_txt(txt$); 4136680
Debug chi_div(a.d, b.d); 3.1600000000000001
Debug chi_mul(a.d, b.d); 19.75

; IDE Options = PureBasic 5.61 (Windows - x86)
; EnableUnicode
; EnableXP

[chi]

thanks,but text bug:
...
Debug chi_txt(txt$); 4136680

Code: Select all

Debug PeekS(chi_txt(txt$))

[gurj]

ok.
but isn't a true UserLibrary for purebasic.

[chi]

update 1.01: AttachProcess, DetachProcess, AttachThread and DetachThread are now ignored by the Import:EndImport output

[RSBasic]

Thanks for sharing.

[Kwai chang caine]

That's works..thanks for sharing

[chi]

update 1.02: Add additional files to the library; Compileable to an IDE-Tool (use ["%HOME" "%FILE"] as arguments);

[Lunasole]

Looks very cool and nicely made.

I have some strange idea of moving program parts to libs, to make code cleaner/shorter. That may be more usable than modules or DLLs.
Just going to ensure there will be no any issues/conflicts (also interesting, will resulting lib work fine with MS VC++ compiler?)

[chi]

(also interesting, will resulting lib work fine with MS VC++ compiler?)

Was hoping you guys could test that ... I'm on a pretty much naked installation of Windows right now. But it should work fine!

[chi]

With a little tool called bin2coff you can create .obj files from your binaries...

Code: Select all

;bin2coff.exe test.7z zip.obj zip

Import "zip.obj"
  zip()
  zip_size()
EndImport

If OpenFile(0, "c:\test.7z")
  WriteData(0, @zip(), PeekQ(@zip_size()) & $FFFFFFFF)
  CloseFile(0)
EndIf

... or load .bmp files

Code: Select all

;bin2coff.exe test.bmp bmp.obj img

Import "bmp.obj"
  img()
  img_size()
EndImport

Procedure LoadImage_OBJ(id, *obj, width, height, depth=24, color=0)
  Protected bmi.BITMAPINFO
  If CreateImage(id, width, height, depth, color)
    bmi\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
    bmi\bmiHeader\biWidth       = width
    bmi\bmiHeader\biHeight      = height
    bmi\bmiHeader\biPlanes      = 1
    bmi\bmiHeader\biBitCount    = depth
    bmi\bmiHeader\biCompression = #BI_RGB
    offset = PeekL(*obj+10) ;Offset where the pixel array (bitmap data) can be found
    SetDIBits_(0, ImageID(id), 0, height, *obj + offset, bmi, #DIB_RGB_COLORS)
  EndIf
EndProcedure

Debug PeekQ(@img_size()) & $FFFFFFFF

LoadImage_OBJ(0, @img(), 800, 450)
ShowLibraryViewer("Image", 0)
CallDebugger

wiki BMP_file_format

You can also add those .obj files to your static lib (add additional files)