MS-Word from PB with COM Interface

[aXend]

Code updated for 5.20+

After a lot of trouble I managed to access MS-Word via COM.
The following code shows the Application Interface.

Code: Select all

DataSection
  CLSID_Application:
  Data.l $000209FF
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection

CLSID_ApplicationStr.s="{000209FF-0000-0000-C000-000000000046}"

DataSection
  IID__Application:
  Data.l $00020970
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection

IID__ApplicationStr.s="{00020970-0000-0000-C000-000000000046}"

Interface _Application Extends IDispatch
  get_Application(a.l)
  get_Creator(a.l)
  get_Parent(a.l)
  get_Name(a.l)
  get_Documents(a.l)
  get_Windows(a.l)
  get_ActiveDocument(a.l)
  get_ActiveWindow(a.l)
  get_Selection(a.l)
  get_WordBasic(a.l)
  get_RecentFiles(a.l)
  get_NormalTemplate(a.l)
  get_System(a.l)
  get_AutoCorrect(a.l)
  get_FontNames(a.l)
  get_LandscapeFontNames(a.l)
  get_PortraitFontNames(a.l)
  get_Languages(a.l)
  get_Assistant(a.l)
  get_Browser(a.l)
  get_FileConverters(a.l)
  get_MailingLabel(a.l)
  get_Dialogs(a.l)
  get_CaptionLabels(a.l)
  get_AutoCaptions(a.l)
  get_AddIns(a.l)
  get_Visible(a.l)
  put_Visible(a.l)
  get_Version(a.l)
  get_ScreenUpdating(a.l)
  put_ScreenUpdating(a.l)
  get_PrintPreview(a.l)
  put_PrintPreview(a.l)
  get_Tasks(a.l)
  get_DisplayStatusBar(a.l)
  put_DisplayStatusBar(a.l)
  get_SpecialMode(a.l)
  get_UsableWidth(a.l)
  get_UsableHeight(a.l)
  get_MathCoprocessorAvailable(a.l)
  get_MouseAvailable(a.l)
  get_International(a.l,b.l)
  get_Build(a.l)
  get_CapsLock(a.l)
  get_NumLock(a.l)
  get_UserName(a.l)
  put_UserName(a.l)
  get_UserInitials(a.l)
  put_UserInitials(a.l)
  get_UserAddress(a.l)
  put_UserAddress(a.l)
  get_MacroContainer(a.l)
  get_DisplayRecentFiles(a.l)
  put_DisplayRecentFiles(a.l)
  get_CommandBars(a.l)
  get_SynonymInfo(a.l,b.l,c.l)
  get_VBE(a.l)
  get_DefaultSaveFormat(a.l)
  put_DefaultSaveFormat(a.l)
  get_ListGalleries(a.l)
  get_ActivePrinter(a.l)
  put_ActivePrinter(a.l)
  get_Templates(a.l)
  get_CustomizationContext(a.l)
  put_CustomizationContext(a.l)
  get_KeyBindings(a.l)
  get_KeysBoundTo(a.l,b.l,c.l,d.l)
  get_FindKey(a.l,b.l,c.l)
  get_Caption(a.l)
  put_Caption(a.l)
  get_Path(a.l)
  get_DisplayScrollBars(a.l)
  put_DisplayScrollBars(a.l)
  get_StartupPath(a.l)
  put_StartupPath(a.l)
  get_BackgroundSavingStatus(a.l)
  get_BackgroundPrintingStatus(a.l)
  get_Left(a.l)
  put_Left(a.l)
  get_Top(a.l)
  put_Top(a.l)
  get_Width(a.l)
  put_Width(a.l)
  get_Height(a.l)
  put_Height(a.l)
  get_WindowState(a.l)
  put_WindowState(a.l)
  get_DisplayAutoCompleteTips(a.l)
  put_DisplayAutoCompleteTips(a.l)
  get_Options(a.l)
  get_DisplayAlerts(a.l)
  put_DisplayAlerts(a.l)
  get_CustomDictionaries(a.l)
  get_PathSeparator(a.l)
  put_StatusBar(a.l)
  get_MAPIAvailable(a.l)
  get_DisplayScreenTips(a.l)
  put_DisplayScreenTips(a.l)
  get_EnableCancelKey(a.l)
  put_EnableCancelKey(a.l)
  get_UserControl(a.l)
  get_FileSearch(a.l)
  get_MailSystem(a.l)
  get_DefaultTableSeparator(a.l)
  put_DefaultTableSeparator(a.l)
  get_ShowVisualBasicEditor(a.l)
  put_ShowVisualBasicEditor(a.l)
  get_BrowseExtraFileTypes(a.l)
  put_BrowseExtraFileTypes(a.l)
  get_IsObjectValid(a.l,b.l)
  get_HangulHanjaDictionaries(a.l)
  get_MailMessage(a.l)
  get_FocusInMailHeader(a.l)
  Quit(a.l,b.l,c.l)
  ScreenRefresh()
  PrintOutOld(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l)
  LookupNameProperties(a.l)
  SubstituteFont(a.l,b.l)
  Repeat(a.l,b.l)
  DDEExecute(a.l,b.l)
  DDEInitiate(a.l,b.l,c.l)
  DDEPoke(a.l,b.l,c.l)
  DDERequest(a.l,b.l,c.l)
  DDETerminate(a.l)
  DDETerminateAll()
  BuildKeyCode(a.l,b.l,c.l,d.l,e.l)
  KeyString(a.l,b.l,c.l)
  OrganizerCopy(a.l,b.l,c.l,d.l)
  OrganizerDelete(a.l,b.l,c.l)
  OrganizerRename(a.l,b.l,c.l,d.l)
  AddAddress(a.l,b.l)
  GetAddress(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l)
  CheckGrammar(a.l,b.l)
  CheckSpelling(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l)
  ResetIgnoreAll()
  GetSpellingSuggestions(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l)
  GoBack()
  Help(a.l)
  AutomaticChange()
  ShowMe()
  HelpTool()
  NewWindow(a.l)
  ListCommands(a.l)
  ShowClipboard()
  OnTime(a.l,b.l,c.l)
  NextLetter()
  MountVolume(a.l,b.l,c.l,d.l,e.l,f.l,g.l)
  CleanString(a.l,b.l)
  SendFax()
  ChangeFileOpenDirectory(a.l)
  RunOld(a.l)
  GoForward()
  Move(a.l,b.l)
  Resize(a.l,b.l)
  InchesToPoints(a.l,b.l)
  CentimetersToPoints(a.l,b.l)
  MillimetersToPoints(a.l,b.l)
  PicasToPoints(a.l,b.l)
  LinesToPoints(a.l,b.l)
  PointsToInches(a.l,b.l)
  PointsToCentimeters(a.l,b.l)
  PointsToMillimeters(a.l,b.l)
  PointsToPicas(a.l,b.l)
  PointsToLines(a.l,b.l)
  Activate()
  PointsToPixels(a.l,b.l,c.l)
  PixelsToPoints(a.l,b.l,c.l)
  KeyboardLatin()
  KeyboardBidi()
  ToggleKeyboard()
  Keyboard(a.l,b.l)
  ProductCode(a.l)
  DefaultWebOptions(a.l)
  DiscussionSupport(a.l,b.l,c.l)
  SetDefaultTheme(a.l,b.l)
  GetDefaultTheme(a.l,b.l)
  get_EmailOptions(a.l)
  get_Language(a.l)
  get_COMAddIns(a.l)
  get_CheckLanguage(a.l)
  put_CheckLanguage(a.l)
  get_LanguageSettings(a.l)
  get_Dummy1(a.l)
  get_AnswerWizard(a.l)
  get_FeatureInstall(a.l)
  put_FeatureInstall(a.l)
  PrintOut2000(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l,s.l)
  Run(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l,s.l,t.l,u.l,v.l,w.l,x.l,y.l,z.l,a1,l,b1.l,c1.l,d1.l,e1.l,f1.l)
  PrintOut(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l,s.l)
  get_AutomationSecurity(a.l)
  put_AutomationSecurity(a.l)
  get_FileDialog(a.l,b.l)
  get_EmailTemplate(a.l)
  put_EmailTemplate(a.l)
  get_ShowWindowsInTaskbar(a.l)
  put_ShowWindowsInTaskbar(a.l)
  get_NewDocument(a.l)
  get_ShowStartupDialog(a.l)
  put_ShowStartupDialog(a.l)
  get_AutoCorrectEmail(a.l)
  get_TaskPanes(a.l)
  get_DefaultLegalBlackline(a.l)
  put_DefaultLegalBlackline(a.l)
  Dummy2(a.l)
  get_SmartTagRecognizers(a.l)
  get_SmartTagTypes(a.l)
  get_XMLNamespaces(a.l)
  PutFocusInMailHeader()
  get_ArbitraryXMLSupportAvailable(a.l)
EndInterface

The document interface comes next.

Code: Select all

DataSection
  IID__Document:
  Data.l $0002096B
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection

IID__DocumentStr.s="{0002096B-0000-0000-C000-000000000046}"

Interface _Document Extends IDispatch
  get_Name(a.l) ; 
  get_Application(a.l) ; 
  get_Creator(a.l) ; 
  get_Parent(a.l) ; 
  get_BuiltInDocumentProperties(a.l) ; 
  get_CustomDocumentProperties(a.l) ; 
  get_Path(a.l) ; 
  get_Bookmarks(a.l) ; 
  get_Tables(a.l) ; 
  get_Footnotes(a.l) ; 
  get_Endnotes(a.l) ; 
  get_Comments(a.l) ; 
  get_Type(a.l) ; 
  get_AutoHyphenation(a.l) ; 
  put_AutoHyphenation(a.l) ; 
  get_HyphenateCaps(a.l) ; 
  put_HyphenateCaps(a.l) ; 
  get_HyphenationZone(a.l) ; 
  put_HyphenationZone(a.l) ; 
  get_ConsecutiveHyphensLimit(a.l) ; 
  put_ConsecutiveHyphensLimit(a.l) ; 
  get_Sections(a.l) ; 
  get_Paragraphs(a.l) ; 
  get_Words(a.l) ; 
  get_Sentences(a.l) ; 
  get_Characters(a.l) ; 
  get_Fields(a.l) ; 
  get_FormFields(a.l) ; 
  get_Styles(a.l) ; 
  get_Frames(a.l) ; 
  get_TablesOfFigures(a.l) ; 
  get_Variables(a.l) ; 
  get_MailMerge(a.l) ; 
  get_Envelope(a.l) ; 
  get_FullName(a.l) ; 
  get_Revisions(a.l) ; 
  get_TablesOfContents(a.l) ; 
  get_TablesOfAuthorities(a.l) ; 
  get_PageSetup(a.l) ; 
  put_PageSetup(a.l) ; 
  get_Windows(a.l) ; 
  get_HasRoutingSlip(a.l) ; 
  put_HasRoutingSlip(a.l) ; 
  get_RoutingSlip(a.l) ; 
  get_Routed(a.l) ; 
  get_TablesOfAuthoritiesCategories(a.l) ; 
  get_Indexes(a.l) ; 
  get_Saved(a.l) ; 
  put_Saved(a.l) ; 
  get_Content(a.l) ; 
  get_ActiveWindow(a.l) ; 
  get_Kind(a.l) ; 
  put_Kind(a.l) ; 
  get_ReadOnly(a.l) ; 
  get_Subdocuments(a.l) ; 
  get_IsMasterDocument(a.l) ; 
  get_DefaultTabStop(a.l) ; 
  put_DefaultTabStop(a.l) ; 
  get_EmbedTrueTypeFonts(a.l) ; 
  put_EmbedTrueTypeFonts(a.l) ; 
  get_SaveFormsData(a.l) ; 
  put_SaveFormsData(a.l) ; 
  get_ReadOnlyRecommended(a.l) ; 
  put_ReadOnlyRecommended(a.l) ; 
  get_SaveSubsetFonts(a.l) ; 
  put_SaveSubsetFonts(a.l) ; 
  get_Compatibility(a.l,b.l) ; 
  put_Compatibility(a.l,b.l) ; 
  get_StoryRanges(a.l) ; 
  get_CommandBars(a.l) ; 
  get_IsSubdocument(a.l) ; 
  get_SaveFormat(a.l) ; 
  get_ProtectionType(a.l) ; 
  get_Hyperlinks(a.l) ; 
  get_Shapes(a.l) ; 
  get_ListTemplates(a.l) ; 
  get_Lists(a.l) ; 
  get_UpdateStylesOnOpen(a.l) ; 
  put_UpdateStylesOnOpen(a.l) ; 
  get_AttachedTemplate(a.l) ; 
  put_AttachedTemplate(a.l) ; 
  get_InlineShapes(a.l) ; 
  get_Background(a.l) ; 
  put_Background(a.l) ; 
  get_GrammarChecked(a.l) ; 
  put_GrammarChecked(a.l) ; 
  get_SpellingChecked(a.l) ; 
  put_SpellingChecked(a.l) ; 
  get_ShowGrammaticalErrors(a.l) ; 
  put_ShowGrammaticalErrors(a.l) ; 
  get_ShowSpellingErrors(a.l) ; 
  put_ShowSpellingErrors(a.l) ; 
  get_Versions(a.l) ; 
  get_ShowSummary(a.l) ; 
  put_ShowSummary(a.l) ; 
  get_SummaryViewMode(a.l) ; 
  put_SummaryViewMode(a.l) ; 
  get_SummaryLength(a.l) ; 
  put_SummaryLength(a.l) ; 
  get_PrintFractionalWidths(a.l) ; 
  put_PrintFractionalWidths(a.l) ; 
  get_PrintPostScriptOverText(a.l) ; 
  put_PrintPostScriptOverText(a.l) ; 
  get_Container(a.l) ; 
  get_PrintFormsData(a.l) ; 
  put_PrintFormsData(a.l) ; 
  get_ListParagraphs(a.l) ; 
  put_Password(a.l) ; 
  put_WritePassword(a.l) ; 
  get_HasPassword(a.l) ; 
  get_WriteReserved(a.l) ; 
  get_ActiveWritingStyle(a.l,b.l) ; 
  put_ActiveWritingStyle(a.l,b.l) ; 
  get_UserControl(a.l) ; 
  put_UserControl(a.l) ; 
  get_HasMailer(a.l) ; 
  put_HasMailer(a.l) ; 
  get_Mailer(a.l) ; 
  get_ReadabilityStatistics(a.l) ; 
  get_GrammaticalErrors(a.l) ; 
  get_SpellingErrors(a.l) ; 
  get_VBProject(a.l) ; 
  get_FormsDesign(a.l) ; 
  get__CodeName(a.l) ; 
  put__CodeName(a.l) ; 
  get_CodeName(a.l) ; 
  get_SnapToGrid(a.l) ; 
  put_SnapToGrid(a.l) ; 
  get_SnapToShapes(a.l) ; 
  put_SnapToShapes(a.l) ; 
  get_GridDistanceHorizontal(a.l) ; 
  put_GridDistanceHorizontal(a.l) ; 
  get_GridDistanceVertical(a.l) ; 
  put_GridDistanceVertical(a.l) ; 
  get_GridOriginHorizontal(a.l) ; 
  put_GridOriginHorizontal(a.l) ; 
  get_GridOriginVertical(a.l) ; 
  put_GridOriginVertical(a.l) ; 
  get_GridSpaceBetweenHorizontalLines(a.l) ; 
  put_GridSpaceBetweenHorizontalLines(a.l) ; 
  get_GridSpaceBetweenVerticalLines(a.l) ; 
  put_GridSpaceBetweenVerticalLines(a.l) ; 
  get_GridOriginFromMargin(a.l) ; 
  put_GridOriginFromMargin(a.l) ; 
  get_KerningByAlgorithm(a.l) ; 
  put_KerningByAlgorithm(a.l) ; 
  get_JustificationMode(a.l) ; 
  put_JustificationMode(a.l) ; 
  get_FarEastLineBreakLevel(a.l) ; 
  put_FarEastLineBreakLevel(a.l) ; 
  get_NoLineBreakBefore(a.l) ; 
  put_NoLineBreakBefore(a.l) ; 
  get_NoLineBreakAfter(a.l) ; 
  put_NoLineBreakAfter(a.l) ; 
  get_TrackRevisions(a.l) ; 
  put_TrackRevisions(a.l) ; 
  get_PrintRevisions(a.l) ; 
  put_PrintRevisions(a.l) ; 
  get_ShowRevisions(a.l) ; 
  put_ShowRevisions(a.l) ; 
  Close(a.l,b.l,c.l) ; 
  SaveAs2000(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l) ; 
  Repaginate() ; 
  FitToPages() ; 
  ManualHyphenation() ; 
  Select() ; 
  DataForm() ; 
  Route() ; 
  Save() ; 
  PrintOutOld(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l) ; 
  SendMail() ; 
  Range(a.l,b.l,c.l) ; 
  RunAutoMacro(a.l) ; 
  Activate() ; 
  PrintPreview() ; 
  Goto(a.l,b.l,c.l,d.l,e.l) ; 
  Undo(a.l,b.l) ; 
  Redo(a.l,b.l) ; 
  ComputeStatistics(a.l,b.l,c.l) ; 
  MakeCompatibilityDefault() ; 
  Protect2002(a.l,b.l,c.l) ; 
  Unprotect(a.l) ; 
  EditionOptions(a.l,b.l,c.l,d.l) ; 
  RunLetterWizard(a.l,b.l) ; 
  GetLetterContent(a.l) ; 
  SetLetterContent(a.l) ; 
  CopyStylesFromTemplate(a.l) ; 
  UpdateStyles() ; 
  CheckGrammar() ; 
  CheckSpelling(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l) ; 
  FollowHyperlink(a.l,b.l,c.l,d.l,e.l,f.l,g.l) ; 
  AddToFavorites() ; 
  Reload() ; 
  AutoSummarize(a.l,b.l,c.l,d.l) ; 
  RemoveNumbers(a.l) ; 
  ConvertNumbersToText(a.l) ; 
  CountNumberedItems(a.l,b.l,c.l) ; 
  Post() ; 
  ToggleFormsDesign() ; 
  Compare2000(a.l) ; 
  UpdateSummaryProperties() ; 
  GetCrossReferenceItems(a.l,b.l) ; 
  AutoFormat() ; 
  ViewCode() ; 
  ViewPropertyBrowser() ; 
  ForwardMailer() ; 
  Reply() ; 
  ReplyAll() ; 
  SendMailer(a.l,b.l) ; 
  UndoClear() ; 
  PresentIt() ; 
  SendFax(a.l,b.l) ; 
  Merge2000(a.l) ; 
  ClosePrintPreview() ; 
  CheckConsistency() ; 
  CreateLetterContent(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l,s.l,t.l,u.l,v.l,w.l,x.l,y.l,z.l,a1.l,b1.l,c1.l,d1.l,e1.l,f1.l) ; 
  AcceptAllRevisions() ; 
  RejectAllRevisions() ; 
  DetectLanguage() ; 
  ApplyTheme(a.l) ; 
  RemoveTheme() ; 
  WebPagePreview() ; 
  ReloadAs(a.l) ; 
  get_ActiveTheme(a.l) ; 
  get_ActiveThemeDisplayName(a.l) ; 
  get_Email(a.l) ; 
  get_Scripts(a.l) ; 
  get_LanguageDetected(a.l) ; 
  put_LanguageDetected(a.l) ; 
  get_FarEastLineBreakLanguage(a.l) ; 
  put_FarEastLineBreakLanguage(a.l) ; 
  get_Frameset(a.l) ; 
  get_ClickAndTypeParagraphStyle(a.l) ; 
  put_ClickAndTypeParagraphStyle(a.l) ; 
  get_HTMLProject(a.l) ; 
  get_WebOptions(a.l) ; 
  get_OpenEncoding(a.l) ; 
  get_SaveEncoding(a.l) ; 
  put_SaveEncoding(a.l) ; 
  get_OptimizeForWord97(a.l) ; 
  put_OptimizeForWord97(a.l) ; 
  get_VBASigned(a.l) ; 
  PrintOut2000(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l) ; 
  sblt(a.l) ; 
  ConvertVietDoc(a.l) ; 
  PrintOut(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l) ; 
  get_MailEnvelope(a.l) ; 
  get_DisableFeatures(a.l) ; 
  put_DisableFeatures(a.l) ; 
  get_DoNotEmbedSystemFonts(a.l) ; 
  put_DoNotEmbedSystemFonts(a.l) ; 
  get_Signatures(a.l) ; 
  get_DefaultTargetFrame(a.l) ; 
  put_DefaultTargetFrame(a.l) ; 
  get_HTMLDivisions(a.l) ; 
  get_DisableFeaturesIntroducedAfter(a.l) ; 
  put_DisableFeaturesIntroducedAfter(a.l) ; 
  get_RemovePersonalInformation(a.l) ; 
  put_RemovePersonalInformation(a.l) ; 
  get_SmartTags(a.l) ; 
  Compare2002(a.l,b.l,c.l,d.l,e.l,f.l) ; 
  CheckIn(a.l,b.l,c.l) ; 
  CanCheckin(a.l) ; 
  Merge(a.l,b.l,c.l,d.l,e.l) ; 
  get_EmbedSmartTags(a.l) ; 
  put_EmbedSmartTags(a.l) ; 
  get_SmartTagsAsXMLProps(a.l) ; 
  put_SmartTagsAsXMLProps(a.l) ; 
  get_TextEncoding(a.l) ; 
  put_TextEncoding(a.l) ; 
  get_TextLineEnding(a.l) ; 
  put_TextLineEnding(a.l) ; 
  SendForReview(a.l,b.l,c.l,d.l) ; 
  ReplyWithChanges(a.l) ; 
  EndReview() ; 
  get_StyleSheets(a.l) ; 
  get_DefaultTableStyle(a.l) ; 
  get_PasswordEncryptionProvider(a.l) ; 
  get_PasswordEncryptionAlgorithm(a.l) ; 
  get_PasswordEncryptionKeyLength(a.l) ; 
  get_PasswordEncryptionFileProperties(a.l) ; 
  SetPasswordEncryptionOptions(a.l,b.l,c.l,d.l) ; 
  RecheckSmartTags() ; 
  RemoveSmartTags() ; 
  SetDefaultTableStyle(a.l,b.l) ; 
  DeleteAllComments() ; 
  AcceptAllRevisionsShown() ; 
  RejectAllRevisionsShown() ; 
  DeleteAllCommentsShown() ; 
  ResetFormFields() ; 
  SaveAs(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l) ; 
  get_EmbedLinguisticData(a.l) ; 
  put_EmbedLinguisticData(a.l) ; 
  get_FormattingShowFont(a.l) ; 
  put_FormattingShowFont(a.l) ; 
  get_FormattingShowClear(a.l) ; 
  put_FormattingShowClear(a.l) ; 
  get_FormattingShowParagraph(a.l) ; 
  put_FormattingShowParagraph(a.l) ; 
  get_FormattingShowNumbering(a.l) ; 
  put_FormattingShowNumbering(a.l) ; 
  get_FormattingShowFilter(a.l) ; 
  put_FormattingShowFilter(a.l) ; 
  CheckNewSmartTags() ; 
  get_Permission(a.l) ; 
  get_XMLNodes(a.l) ; 
  get_XMLSchemaReferences(a.l) ; 
  get_SmartDocument(a.l) ; 
  get_SharedWorkspace(a.l) ; 
  get_Sync(a.l) ; 
  get_EnforceStyle(a.l) ; 
  put_EnforceStyle(a.l) ; 
  get_AutoFormatOverride(a.l) ; 
  put_AutoFormatOverride(a.l) ; 
  get_XMLSaveDataOnly(a.l) ; 
  put_XMLSaveDataOnly(a.l) ; 
  get_XMLHideNamespaces(a.l) ; 
  put_XMLHideNamespaces(a.l) ; 
  get_XMLShowAdvancedErrors(a.l) ; 
  put_XMLShowAdvancedErrors(a.l) ; 
  get_XMLUseXSLTWhenSaving(a.l) ; 
  put_XMLUseXSLTWhenSaving(a.l) ; 
  get_XMLSaveThroughXSLT(a.l) ; 
  put_XMLSaveThroughXSLT(a.l) ; 
  get_DocumentLibraryVersions(a.l) ; 
  get_ReadingModeLayoutFrozen(a.l) ; 
  put_ReadingModeLayoutFrozen(a.l) ; 
  get_RemoveDateAndTime(a.l) ; 
  put_RemoveDateAndTime(a.l) ; 
  SendFaxOverInternet(a.l,b.l,c.l) ; 
  TransformDocument(a.l,b.l) ; 
  Protect(a.l,b.l,c.l,d.l,e.l) ; 
  SelectAllEditableRanges(a.l) ; 
  DeleteAllEditableRanges(a.l) ; 
  DeleteAllInkAnnotations() ; 
  AddDocumentWorkspaceHeader(a.l,b.l,c.l,d.l,e.l) ; 
  RemoveDocumentWorkspaceHeader(a.l) ; 
  Compare(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l) ; 
  RemoveLockedStyles() ; 
  get_ChildNodeSuggestions(a.l) ; 
  SelectSingleNode(a.l,b.l,c.l,d.l) ; 
  SelectNodes(a.l,b.l,c.l,d.l) ; 
  get_XMLSchemaViolations(a.l) ; 
  get_ReadingLayoutSizeX(a.l) ; 
  put_ReadingLayoutSizeX(a.l) ; 
  get_ReadingLayoutSizeY(a.l) ; 
  put_ReadingLayoutSizeY(a.l) ; 
EndInterface

Finally the Documents interface.

Code: Select all

DataSection
  IID_Documents:
  Data.l $0002096C
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection

IID_DocumentsStr.s="{0002096C-0000-0000-C000-000000000046}"

Interface Documents Extends IDispatch
  get__NewEnum(a.l) ; 
  get_Count(a.l) ; 
  get_Application(a.l) ; 
  get_Creator(a.l) ; 
  get_Parent(a.l) ; 
  Item(a.l,b.l) ; 
  Close(a.l,b.l,c.l) ; 
  AddOld(a.l,b.l,c.l) ; 
  OpenOld(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l) ; 
  Save(a.l,b.l) ; 
  Add(a.l,b.l,c.l,d.l,e.l) ; 
  Open2000(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l) ; 
  CheckOut(a.l) ; 
  CanCheckOut(a.l,b.l) ; 
  Open2002(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l) ; 
  Open(a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l) ; 
EndInterface

To use these interfaces use the following code.

Code: Select all

IncludeFile "Word_Application.pb"
IncludeFile "Word_Documents.pb"
IncludeFile "Word_Document.pb"

#CLSCTX_INPROC_SERVER  = 1
#CLSCTX_INPROC_HANDLER = 2
#CLSCTX_LOCAL_SERVER   = 4 
#CLSCTX_REMOTE_SERVER  = 16

#vbNormal = 0

Global oWord._Application
Global oDocs.Documents
Global oDoc._Document

Procedure.s Uni2Ansi(unicodestr.l)
  lenA = WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, 0, 0, 0, 0);
  ansistr.s = Space(lenA)
  If (lenA > 0)
    WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, @ansistr, lenA, 0, 0);
  EndIf
  ProcedureReturn ansistr
EndProcedure

Procedure.l Ansi2Uni(ansistr.s)
  lenA.l = Len(ansistr)
  lenW = MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, 0, 0)
  If (lenW > 0) ; Check whether conversion was successful
    unicodestr = SysAllocStringLen_(0, lenW)
    MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, unicodestr, lenW)
    result = unicodestr
    SysFreeString_(unicodestr)
    ProcedureReturn result
  Else 
    ProcedureReturn 0
  EndIf
EndProcedure

;- Start program
OleInitialize_(0) 

If CoCreateInstance_(?CLSID_Application,0,#CLSCTX_LOCAL_SERVER,?IID__Application,@oWord)<>0
  MessageRequester("Warning:","Couldn't init oWord",0)
  End
EndIf
Debug oWord
oWord\put_WindowState(#vbNormal)
oWord\put_Height(300)
oWord\put_Width(400)
oWord\put_Left(40)
oWord\put_Top(300)
oWord\put_Caption(Ansi2Uni("Word from PureBasic"))
oWord\put_Statusbar(Ansi2Uni("Date: " + FormatDate("%mm/%dd/%yyyy", Date())))
oWord\put_Visible(#True)
oWord\Quit(#False,#False,#False)
oWord\Release()

OleUninitialize_()

End 

I have some difficulties to activate a document in Word. I can use

Code: Select all

oWord\get_NewDocument(@oDoc)

That gives me a handle to a Document, but I can't use any of the methods and it doesn't show a new document either. Does anyone have clue on this?

[Fred]

Very good work . When you deal with normal function (ie: not a put_ or get_ function), you need to use the VARIANT type for each parameter. And before I forget, comment the SysFreeString_() in the Ansi2Uni() procedure, as you are returning a freed pointer (works with luck !). Here is a little snippet to let you started (put it after your commands):

Code: Select all

If oWord\Get_Documents(@oDocs) = #S_OK

  ; Declare our 'none' variant (for the optionals parameters)
  ;
  None.VARIANT\vt = #VT_ERROR
  None\scode      = #DISP_E_PARAMNOTFOUND

  ; And the file name, which has to be a variant
  ;
  FileName.VARIANT\vt = #VT_BSTR
  FileName\bstrVal    = SysAllocString_(Ansi2Uni("C:\Lettre de motivation.doc"))

  If oDocs\OpenOld(FileName, None, None, None, None, None, None, None, None, None, @oDocument._Document) = #S_OK

    oDocument\Close(None, None, None)

    oDocument\Release() ; Don't forget to release the object
  EndIf
EndIf

And the Variant.pb header file (not complete):

Code: Select all

Structure VARIANT 
  vt.w 
  wReserved1.w 
  wReserved2.w    
  wReserved3.w 
  StructureUnion
    value.l 
    bstrVal.l
    scode.l
  EndStructureUnion
EndStructure 


#VT_EMPTY = 0
#VT_NULL = 1
#VT_I2 = 2
#VT_I4 = 3
#VT_R4 = 4
#VT_R8 = 5
#VT_CY = 6
#VT_DATE = 7
#VT_BSTR = 8
#VT_DISPATCH = 9
#VT_ERROR = 10
#VT_BOOL = 11
#VT_VARIANT = 12
#VT_UNKNOWN = 13
#VT_DECIMAL = 14
#VT_I1 = 16
#VT_UI1 = 17
#VT_UI2 = 18
#VT_UI4 = 19
#VT_I8 = 20
#VT_UI8 = 21
#VT_INT = 22
#VT_UINT = 23
#VT_VOID = 24
#VT_HRESULT = 25
#VT_PTR = 26
#VT_SAFEARRAY = 27
#VT_CARRAY = 28
#VT_USERDEFINED = 29
#VT_LPSTR = 30
#VT_LPWSTR = 31
#VT_RECORD = 36
#VT_FILETIME = 64
#VT_BLOB = 65
#VT_STREAM = 66
#VT_STORAGE = 67
#VT_STREAMED_OBJECT = 68
#VT_STORED_OBJECT = 69
#VT_BLOB_OBJECT = 70
#VT_CF = 71
#VT_CLSID = 72
#VT_BSTR_BLOB = $fff
#VT_VECTOR = $1000
#VT_ARRAY = $2000
#VT_BYREF = $4000
#VT_RESERVED = $8000
#VT_ILLEGAL = $ffff
#VT_ILLEGALMASKED = $fff
#VT_TYPEMASK = $fff

#DISP_E_PARAMNOTFOUND = $80020004

[Fred]

And another one, which iterates the currently opened documents and display there name:

Code: Select all

If oWord\Get_Documents(@oDocs) = #S_OK

  ; Declare our 'none' variant (for optional parameters we don't fill)
  ;
  None.VARIANT\vt = #VT_ERROR
  None\scode      = #DISP_E_PARAMNOTFOUND

  ; And the file name, which has to be a variant
  ;
  FileName.VARIANT\vt = #VT_BSTR
  FileName\bstrVal    = SysAllocString_(Ansi2Uni("C:\Lettre de motivation.doc"))

  If oDocs\OpenOld(FileName, None, None, None, None, None, None, None, None, None, @oDocument._Document) = #S_OK
    oDocument\Release() ; We don't need the interface anymore
  EndIf


  FileName\bstrVal    = SysAllocString_(Ansi2Uni("C:\Fredfred.doc"))

  If oDocs\OpenOld(FileName, None, None, None, None, None, None, None, None, None, @oDocument._Document) = #S_OK
    oDocument\Release()
  EndIf
  
  oDocs\get_Count(@NbDocuments)

  Index.VARIANT\vt = #VT_I4
  
  For k=1 To NbDocuments
  
    Index\value = k
  
    If oDocs\Item(Index, @CurrentDoc._Document) = #S_OK
      Debug "Item: "+Str(k)
           
      If CurrentDoc\get_Name(@Name) = #S_OK
        Debug Uni2Ansi(Name)
        
        SysFreeString_(Name) ; Don't forget to free it !
      EndIf
      
      CurrentDoc\Release()
    EndIf
  Next

EndIf

[aXend]

Thanks Fred! I was trying to use the VARIANT type too, but I had the wrong structure. May be it shoud be in the Structure Library?
That with the None variant did it! I was struggling with al those optionals and couldn't find a way to get around it.

This works fine too:

Code: Select all

If oDocs\Add(None, None, None, None, @oDocument._Document) = #S_OK
    
  Debug oDocument

  oDocument\Close(None, None, None) 

  oDocument\Release() ; Don't forget to release the object 
EndIf

I also have two other interfaces: Templates (collection) and Template.

This is the Templates interface.

Code: Select all

DataSection
  IID_Templates:
  Data.l $000209A2
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection

IID_TemplatesStr.s="{000209A2-0000-0000-C000-000000000046}"

Interface Templates Extends IDispatch
  get_Application(a.l) ; 
  get_Creator(a.l) ; 
  get_Parent(a.l) ; 
  get_Count(a.l) ; 
  get__NewEnum(a.l) ; 
  Item(a.l,b.l) ; 
EndInterface

This is the Template interface.

Code: Select all

DataSection
  IID_Template:
  Data.l $0002096A
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection

IID_TemplateStr.s="{0002096A-0000-0000-C000-000000000046}"

Interface Template Extends IDispatch
  get_Name(a.l) ; 
  get_Application(a.l) ; 
  get_Creator(a.l) ; 
  get_Parent(a.l) ; 
  get_Path(a.l) ; 
  get_AutoTextEntries(a.l) ; 
  get_LanguageID(a.l) ; 
  put_LanguageID(a.l) ; 
  get_Saved(a.l) ; 
  put_Saved(a.l) ; 
  get_Type(a.l) ; 
  get_FullName(a.l) ; 
  get_BuiltInDocumentProperties(a.l) ; 
  get_CustomDocumentProperties(a.l) ; 
  get_ListTemplates(a.l) ; 
  get_LanguageIDFarEast(a.l) ; 
  put_LanguageIDFarEast(a.l) ; 
  get_VBProject(a.l) ; 
  get_KerningByAlgorithm(a.l) ; 
  put_KerningByAlgorithm(a.l) ; 
  get_JustificationMode(a.l) ; 
  put_JustificationMode(a.l) ; 
  get_FarEastLineBreakLevel(a.l) ; 
  put_FarEastLineBreakLevel(a.l) ; 
  get_NoLineBreakBefore(a.l) ; 
  put_NoLineBreakBefore(a.l) ; 
  get_NoLineBreakAfter(a.l) ; 
  put_NoLineBreakAfter(a.l) ; 
  OpenAsDocument(a.l) ; 
  Save() ; 
  get_NoProofing(a.l) ; 
  put_NoProofing(a.l) ; 
  get_FarEastLineBreakLanguage(a.l) ; 
  put_FarEastLineBreakLanguage(a.l) ; 
EndInterface

I will continue with this a little further. I'll keep you posted. Thanks again.

[Fred]

Do you convert these interfaces by hands ? It would be nice to create an 'Office.res' with all the COM interfaces for every objects declared. Would ease the thing a lot.

[aXend]

No I don't code the interfaces by hand. I use a program derived from input by Leo . I agree that an "Office.res" would by nice. I don't know how to do that, but I'm sure you can help me with it.

The code I use for interface generation is below.

This is the include file.

Code: Select all

Enumeration 
  #INVOKE_FUNC             = 1 
  #INVOKE_PROPERTYGET      = 2 
  #INVOKE_PROPERTYPUT      = 4 
  #INVOKE_PROPERTYPUTREF   = 8 
EndEnumeration 

Enumeration 
  #USERCLASSTYPE_FULL       = 1 
  #USERCLASSTYPE_SHORT  
  #USERCLASSTYPE_APPNAME 
EndEnumeration 

Enumeration 
  #TKIND_ENUM  
  #TKIND_RECORD 
  #TKIND_MODULE 
  #TKIND_INTERFACE 
  #TKIND_DISPATCH 
  #TKIND_COCLASS 
  #TKIND_ALIAS 
  #TKIND_UNION 
  #TKIND_MAX  
EndEnumeration 

Enumeration 
  #FUNC_VIRTUAL    = 0 
  #FUNC_PUREVIRTUAL= #FUNC_VIRTUAL + 1 
  #FUNC_NONVIRTUAL = #FUNC_PUREVIRTUAL + 1 
  #FUNC_STATIC     = #FUNC_NONVIRTUAL + 1 
  #FUNC_DISPATCH   = #FUNC_STATIC + 1 
EndEnumeration 

Enumeration 
  #VAR_PERINSTANCE = 0 
  #VAR_STATIC      = #VAR_PERINSTANCE + 1 
  #VAR_CONST       = #VAR_STATIC + 1 
  #VAR_DISPATCH    = #VAR_CONST + 1 
EndEnumeration  

Enumeration 
  #VT_EMPTY 
  #VT_NULL 
  #VT_I2 
  #VT_I4 
  #VT_R4 
  #VT_R8 
  #VT_CY 
  #VT_DATE 
  #VT_BSTR 
  #VT_DISPATCH 
  #VT_ERROR 
  #VT_BOOL 
  #VT_VARIANT 
  #VT_UNKNOWN 
  #VT_DECIMAL 
  #VT_I1           = 16 
  #VT_UI1 
  #VT_UI2 
  #VT_UI4 
  #VT_I8 
  #VT_UI8 
  #VT_INT 
  #VT_UINT 
  #VT_VOID 
  #VT_HRESULT 
  #VT_PTR 
  #VT_SAFEARRAY 
  #VT_CARRAY 
  #VT_USERDEFINED 
  #VT_LPSTR 
  #VT_LPWSTR 
  #VT_RECORD       = 36 
  #VT_FILETIME     = 64 
  #VT_BLOB         = 65 
  #VT_STREAM       = 66 
  #VT_STORAGE      = 67 
  #VT_STREAMED_OBJECT      = 68 
  #VT_STORED_OBJECT        = 69 
  #VT_BLOB_OBJECT  = 70 
  #VT_CF           = 71 
  #VT_CLSID        = 72 
  #VT_BSTR_BLOB    = $fff 
  #VT_VECTOR       = $1000 
  #VT_ARRAY        = $2000 
  #VT_BYREF        = $4000 
  #VT_RESERVED     = $8000 
  #VT_ILLEGAL      = $ffff 
  #VT_ILLEGALMASKED= $fff 
  #VT_TYPEMASK     = $fff 
EndEnumeration                

Enumeration 
  #PARAMFLAG_NONE = $00 
  #PARAMFLAG_FIN = $01 
  #PARAMFLAG_FOUT = $02 
  #PARAMFLAG_FLCID = $04 
  #PARAMFLAG_FRETVAL = $08 
  #PARAMFLAG_FOPT = $10 
  #PARAMFLAG_FHASDEFAULT = $20 
  #PARAMFLAG_FHASCUSTDATA = $40 
EndEnumeration                

Structure VARIANTARG 
  vt.w 
  dummy1.w 
  dummy2.w 
  dummy3.w 
  union.l 
EndStructure 

Structure PARAMDESC 
  pparamdescex.l 
  wParamFlags.w 
EndStructure  

Structure PARAMDESCEX 
  cBytes.l 
  dummy.l   ; Deze dummy begrijp ik niet 
  varDefaultValue.VARIANTARG 
EndStructure 

Structure TYPEDESC 
  union.l 
  vt.w 
EndStructure 

Structure ELEMDESC 
  tdesc.TYPEDESC 
  dummy.w 
  paramdesc.PARAMDESC 
  dummy.w 
EndStructure 

Structure FUNCDESC 
  memid.l 
  scode.l 
  *lprgelemdescParam.ELEMDESC 
  funckind.l 
  invokekind.l 
  callconv.l 
  cParams.w 
  cParamsOpt.w 
  oVft.w 
  cScodes.w 
  *elemdescFunc.ELEMDESC 
  wFuncFlags.w 
EndStructure 

Structure TYPEATTR 
  guid.GUID 
  lcid.l 
  dwReserved.l 
  memidConstructor.l 
  memidDestructor.l 
  lpstrSchema.l 
  cbSizeInstance.l 
  typekind.l 
  cFuncs.w 
  cVars.w 
  cImplTypes.w 
  cbSizeVft.w 
  cbAlignment.w 
  wTypeFlags.w 
  wMajorVerNum.w 
  wMinorVerNum.w 
  tdescAlias.l 
  idldescType.l 
EndStructure 

Structure VARDESC 
  memid.l 
  lpstrSchema.l 
  union.l 
  *elemdescVar.ELEMDESC 
  wVarFlags.w 
  varkind.w 
EndStructure  

Procedure.s HexString(Source.l, l.l) 
    result.s 
    
    result.s = "" 
    For i = 0 To l 
        result = result + Right("00" + Hex(PeekB(PeekL(Source)+i)), 2) + " " 
    Next i 
    
    ProcedureReturn result 
EndProcedure 


Procedure.s ByteStr(pointer.l) 
  strlen.w = WideCharToMultiByte_(#CP_ACP, 0, pointer, -1, 0, 0 , 0, 0) 
  string.s = Space(strlen) 
  If strlen <> 0 
    newlen.w = WideCharToMultiByte_(#CP_ACP, 0, pointer, -1, @string, strlen , 0, 0) 
  EndIf 
  ProcedureReturn string 
EndProcedure 

Procedure.l WideStr(pointer.l, mem.l) 
  widelen.w = 2*Len(PeekS(pointer))+2 
  widebuf.l = AllocateMemory(widelen) 
  longlen.w = MultiByteToWideChar_(#CP_ACP,0,pointer,-1,widebuf,widelen) 
  ProcedureReturn widebuf 
EndProcedure 

Procedure CheckFatalError(Err.l, ErrTxt.s) 
  If Err <> 0 
    MessageRequester("Fatal Error",ErrTxt+", Error : "+Hex(Err) ,0) 
    End 
  EndIf 
EndProcedure 
  
Procedure.l CheckError(Err.l, ErrTxt.s) 
  If Err <> 0 
    MessageRequester("Information",ErrTxt+", Error : "+Hex(Err) ,0) 
    ProcedureReturn 1 
  EndIf 
  ProcedureReturn 0 
EndProcedure  

Procedure.s stringCustomType(RefType.l, pTypeInfo.l) 
  *TypeInfo.ITypeInfo=pTypeInfo 
  
  If *TypeInfo\GetRefTypeInfo(RefType, @CustTypeInfo.ITypeInfo)=0 
    If CustTypeInfo\GetDocumentation(-1, @bstrType, 0, 0, 0)=0 
      ProcedureReturn ByteStr(bstrType) 
    Else 
      ProcedureReturn "UnknownCustomType" 
    EndIf 
  Else 
    ProcedureReturn "UnknownCustomType" 
  EndIf  
  ProcedureReturn "UnknownCustomType" 
EndProcedure 

Procedure.s stringTypeDesc(pTypeDesc.l, pTypeInfo.l) 
  *TypeDesc.TYPEDESC=pTypeDesc 
  *TypeInfo.ITypeInfo=pTypeInfo 
  If *TypeDesc\vt = #VT_PTR 
    ProcedureReturn stringTypeDesc(*TypeDesc\union, pTypeInfo)+"*" 
  EndIf  
  If *TypeDesc\vt = #VT_SAFEARRAY 
    ProcedureReturn "SAFEARRAY("+stringTypeDesc(*TypeDesc\union, pTypeInfo)+")" 
  EndIf  
;  If pTypeDesc\vt = #VT_CARRAY 
;    CArray.s=stringTypeDesc(@*TypeDesc\lpadesc\tdescElem, @*TypeInfo) 
;  EndIf  
;  If pTypeDesc\vt = #VT_USERDEFINED 
;    CArray.s=stringTypeDesc(@*TypeDesc\lpadesc\tdescElem, @*TypeInfo) 
;  EndIf  
;    If(typeDesc->vt == VT_CARRAY) { 
;        oss<< stringifyTypeDesc(&typeDesc->lpadesc->tdescElem, pTypeInfo); 
;        for(int dim(0); typeDesc->lpadesc->cDims; ++dim) 
;            oss<< '['<< typeDesc->lpadesc->rgbounds[dim].lLbound<< "..." 
;                << (typeDesc->lpadesc->rgbounds[dim].cElements + 
;                typeDesc->lpadesc->rgbounds[dim].lLbound - 1)<< ']'; 
;        return oss.str(); 
;    } 
  If *TypeDesc\vt = #VT_USERDEFINED 
    ProcedureReturn stringCustomType(*TypeDesc\union, pTypeInfo) 
  EndIf 
  Vt.l=*TypeDesc\vt 
  Select Vt.l 
    Case #VT_I2: ProcedureReturn "short"; 
    Case #VT_I4: ProcedureReturn "long"; 
    Case #VT_R4: ProcedureReturn "float"; 
    Case #VT_R8: ProcedureReturn "double"; 
    Case #VT_CY: ProcedureReturn "CY"; 
    Case #VT_DATE: ProcedureReturn "DATE"; 
    Case #VT_BSTR: ProcedureReturn "BSTR"; 
    Case #VT_DISPATCH: ProcedureReturn "IDispatch*"; 
    Case #VT_ERROR: ProcedureReturn "SCODE"; 
    Case #VT_BOOL: ProcedureReturn "VARIANT_BOOL"; 
    Case #VT_VARIANT: ProcedureReturn "VARIANT"; 
    Case #VT_UNKNOWN: ProcedureReturn "IUnknown*"; 
    Case #VT_UI1: ProcedureReturn "BYTE"; 
    Case #VT_DECIMAL: ProcedureReturn "DECIMAL"; 
    Case #VT_I1: ProcedureReturn "char"; 
    Case #VT_UI2: ProcedureReturn "USHORT"; 
    Case #VT_UI4: ProcedureReturn "ULONG"; 
    Case #VT_I8: ProcedureReturn "__int64"; 
    Case #VT_UI8: ProcedureReturn "unsigned __int64"; 
    Case #VT_INT: ProcedureReturn "int"; 
    Case #VT_UINT: ProcedureReturn "UINT"; 
    Case #VT_HRESULT: ProcedureReturn "HRESULT"; 
    Case #VT_VOID: ProcedureReturn "void" 
    Case #VT_LPSTR: ProcedureReturn "char*"; 
    Case #VT_LPWSTR: ProcedureReturn "wchar_t*"; 
  EndSelect 
  ProcedureReturn "BIG ERROR!"; 
EndProcedure 

Procedure.s stringVarDesc(pVarDesc.l, pTypeInfo.l) 
  *VarDesc.VARDESC=pVarDesc 
  *TypeInfo.ITYPEINFO=pTypeInfo 
  bstrName.s 
  If *VarDesc\varkind = #VAR_CONST 
    RetStr.s="const "+stringTypeDesc(@*VarDesc\elemdescVar\tdesc, @*TypeInfo) 
    If *TypeInfo\GetDocumentation(*VarDesc\memid, @bstrName ,0, 0, 0) 
      RetStr=RetStr+" "+ByteStr(@bstrName)+" = " 
      If VariantChangeType_( @Variant, *VarDesc\union,0,#VT_BSTR) 
        RetStr=RetStr+"???" 
      Else 
        RetStr=RetStr+ByteStr(@Variant) 
      EndIf    
    Else 
      RetStr="UnknownName" 
    EndIf 
  EndIf 
  ProcedureReturn RetStr    
EndProcedure 

Procedure.s stringParameterAttributes(pParamDesc.l) 
  *ParamDesc.PARAMDESC=pParamDesc 
  paramFlags.w = *ParamDesc\wParamFlags 
  
  numFlags.l=0 
  bit.l=1 
  While bit < #PARAMFLAG_FHASDEFAULT 
    If paramFlags & bit 
      numFlags=numFlags+1 
    EndIf 
    bit=bit*2 
  Wend 
  If numFlags=0 
    ProcedureReturn "" 
  EndIf 
  RetStr.s="[" 
  If paramFlags & #PARAMFLAG_FIN 
    RetStr=RetStr+"in, " 
  EndIf 
  If paramFlags & #PARAMFLAG_FOUT 
    RetStr=RetStr+"out, " 
  EndIf 
  If paramFlags & #PARAMFLAG_FLCID 
    RetStr=RetStr+"lcid, " 
  EndIf 
  If paramFlags & #PARAMFLAG_FRETVAL 
    RetStr=RetStr+"retval, " 
  EndIf 
  If paramFlags & #PARAMFLAG_FOPT 
    RetStr=RetStr+"optional, " 
  EndIf 
  If paramFlags & #PARAMFLAG_FHASDEFAULT 
    RetStr=RetStr+"defaultvalue=" 
    If *ParamDesc\pparamdescex 
      *ParamDescEx.PARAMDESCEX=*ParamDesc\pparamdescex 
      *varDefaultValue.VARIANTARG=*ParamDescEx\varDefaultValue 
      
      If VariantChangeType_(@Variant.VARIANTARG,*varDefaultValue,0,#VT_BSTR)=0 
        If *varDefaultValue\vt = #VT_BSTR 
          RetStr=RetStr+Chr(34) 
        EndIf 
        RetStr=RetStr+ByteStr(Variant\union) 
        If *varDefaultValue\vt = #VT_BSTR 
          RetStr=RetStr+Chr(34) 
        EndIf  
      Else 
        RetStr=RetStr+"???" 
      EndIf 
    EndIf 
  EndIf 
    If Right(RetStr,2)=", " 
      RetStr=Left(RetStr, Len(RetStr)-2) 
    EndIf 
    RetStr=RetStr+"]" 
  ProcedureReturn RetStr 
EndProcedure  

Procedure.s stringFunctionArgument(pElemDesc.l, pTypeInfo.l) 
    *ElemDesc.ELEMDESC=pElemDesc 
    *TypeInfo.ITypeInfo=pTypeInfo 
    pParamDesc.l=@*ElemDesc\paramdesc 
    RetStr.s=stringParameterAttributes(pParamDesc) 
    If Len(RetStr)>0 
      RetStr=RetStr+" "      
    EndIf 
    pTypeDesc.l=@*ElemDesc\tdesc 
    RetStr=RetStr+stringTypeDesc(pTypeDesc.l, pTypeInfo) 
  ProcedureReturn RetStr 
EndProcedure 

Procedure.s stringCOMMethod(pFuncDesc.l, pTypeInfo.l) 
  *FuncDesc.FUNCDESC=pFuncDesc 
  *TypeInfo.ITypeInfo=pTypeInfo  
  If *FuncDesc\funckind = #FUNC_DISPATCH    
    RetStr.s="[id($"+Hex(*FuncDesc\memid)+")" 
  Else 
    RetStr.s="[VOffset($"+Hex(*FuncDesc\oVft)+")" 
  EndIf  
  Select *FuncDesc\invokekind 
    Case #INVOKE_PROPERTYGET 
      RetStr=RetStr+", propget] " 
    Case #INVOKE_PROPERTYPUT 
      RetStr=RetStr+", propput] " 
    Case #INVOKE_PROPERTYPUTREF 
      RetStr=RetStr+", propputref] " 
    Case #INVOKE_FUNC 
      RetStr=RetStr+"] " 
  EndSelect 
  RetStr=RetStr+stringTypeDesc(@*FuncDesc\elemdescFunc, pTypeInfo) 
  MemberID.l=*FuncDesc\memid 
  Err.l=*TypeInfo\GetDocumentation(MemberID, @bstrName, NULL, NULL, NULL) 
  RetStr=RetStr+" "+ByteStr(bstrName)+"(" 
  RetNr.l 
  ParNames.s=Space(1000) 
  Nr.l=*FuncDesc\cParams 
  Err.l=*TypeInfo\GetNames(MemberID,@ParNames,Nr.l+1, @RetNr) 
  If *FuncDesc\cParams > 0 
    pTemp.l=*FuncDesc\lprgelemdescParam 
  EndIf  
  pElemDescParam.l=pTemp 
  For i=0 To *FuncDesc\cParams-1 
    If i>0 
      RetStr=RetStr+", " 
    EndIf 
    RetStr=RetStr+stringFunctionArgument(pElemDescParam, pTypeInfo) 
    RetStr=RetStr+" "+ByteStr(PeekL(@ParNames+((i+1)*4))) 
    pElemDescParam=pElemDescParam+SizeOf(ELEMDESC) 
  Next 
  RetStr=RetStr+")" 
  ProcedureReturn RetStr 
EndProcedure  

And this is the generator itself.

Code: Select all

IncludeFile "Word_interfaces_inc.pb"

Global oTypeLib.ITypeLib
Global Title.s
Title = "Interface Generator"

Procedure.s Uni2Ansi(unicodestr.l)
  lenA = WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, 0, 0, 0, 0);
  ansistr.s = Space(lenA)
  If (lenA > 0)
    WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, @ansistr, lenA, 0, 0);
  EndIf
  ProcedureReturn ansistr
EndProcedure

Procedure.l Ansi2Uni(ansistr.s)
  lenA.l = Len(ansistr)
  lenW = MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, 0, 0)
  If (lenW > 0) ; Check whether conversion was successful
    unicodestr = SysAllocStringLen_(0, lenW)
    MultiByteToWideChar_(CP_ACP, 0, ansistr, lenA, unicodestr, lenW)
    result = unicodestr
    SysFreeString_(unicodestr)
    ProcedureReturn result
  Else 
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure GetDataSection(type.s,idstr.s)
  WriteStringN("DataSection")
  WriteStringN("  "+type+":")
  WriteStringN("  Data.l $"+Mid(idstr,2,8))
  WriteStringN("  Data.w $"+Mid(idstr,11,4)+",$"+Mid(idstr,16,4))
  WriteStringN("  Data.b $"+Mid(idstr,21,2)+",$"+Mid(idstr,23,2)+",$"+Mid(idstr,26,2)+",$"+Mid(idstr,28,2)+",$"+Mid(idstr,30,2)+",$"+Mid(idstr,32,2)+",$"+Mid(idstr,34,2)+",$"+Mid(idstr,36,2))
  WriteStringN("EndDataSection")
  WriteStringN("")
  WriteStringN(type+"Str.s="+Chr(34)+idstr+Chr(34))
  WriteStringN("")
EndProcedure               

Procedure.l SaveFile()
  StandardFile$ = "C:\Programmeren\PureBasic\temp.pb"   ; set initial file+path to display 
  Pattern$ = "PureBasic (*.pb)|*.pb|All files (*.*)|*.*" 
  Pattern = 0    ; use the first of the three possible patterns as standard 
  File$ = SaveFileRequester("Please choose file to save", StandardFile$, Pattern$, Pattern) 
  If File$ 
    If Pattern=0 And FindString(File$,".",1) = 0 
      File$=File$+".pb"
    EndIf 
    If OpenFile(#PB_Any,File$) = 0
      MessageRequester(Title, "The file could not be opened", 0)
      ProcedureReturn 0
    Else
      ProcedureReturn 1
    EndIf  
  Else 
    MessageRequester(Title, "The requester was canceled.", 0) 
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure LoadTypeLib(TypeLib.s)
  tchVersionInformation.s=Space(100) 
  Err.l=RegOpenKeyEx_(#HKEY_CLASSES_ROOT,"TypeLib\"+TypeLib,0,#KEY_READ, @hKeyClassTLB.l) 
  If CheckError(Err,"Typelib not registered") 
    NoRegTLB=1 
  Else  
    dwCLSIDSubKeyIndex.l = 0 
    While RegEnumKey_(hKeyClassTLB,dwCLSIDSubKeyIndex ,@tchVersionInformation,20) =0 
      If RegOpenKeyEx_(hKeyClassTLB,@tchVersionInformation,0,#KEY_READ,@hKeyVersion.l) =0    
      EndIf 
      dwCLSIDSubKeyIndex=dwCLSIDSubKeyIndex+1
    Wend
    clsidTypeLib.GUID 
    A$ = Space((Len(TypeLib)+1)*2) 
    MultiByteToWideChar_(#CP_ACP,0,TypeLib,-1,@A$,Len(A$)) 
    Err.l = CLSIDFromString_(A$,clsidTypeLib) 
    CheckFatalError(Err,"Not a valid ClassId") 
    Major.l=Val(tchVersionInformation)
    Pos.l = FindString(tchVersionInformation,".",1) 
    tchVersionInformation.s=Mid(tchVersionInformation,Pos+1,100) 
    Minor.l=Val(tchVersionInformation)
    Err.l = LoadRegTypeLib_(clsidTypeLib,Major,Minor,0, @oTypeLib.ITypeLib) 
    If CheckError(Err,"Can't load registered TypeLib") 
      NoRegTLB=1 
    EndIf 
  EndIf
EndProcedure

Procedure AnalyseTypeLib(InterfaceID.s)
  Nr.l = oTypeLib\GetTypeInfoCount()
  Dim Interfaces.s(Nr-1) 
  For I = 0 To Nr-1 
    Err.l = oTypeLib\GetDocumentation(I, @bstrName, @bstrDocString, #Null, #Null) 
    CheckFatalError(Err,"Can't extract Interface from TypeLib") 
    Interfaces(I) = Uni2Ansi(PeekL(@bstrName)) 
  Next
  Params.s=" a.l,b.l,c.l,d.l,e.l,f.l,g.l,h.l,i.l,j.l,k.l,l.l,m.l,n.l,o.l,p.l,q.l,r.l,s.l,t.l,u.l,v.l,w.l,x.l,y.l,z.l" 
  For I = 0 To Nr-1
    If Interfaces(I) = InterfaceID
      Index.l = I 
    EndIf
  Next
  Debug Index
  Err.l = oTypeLib\GetTypeInfo(Index, @oCurrentTypeInfo.ITypeInfo); 
  CheckFatalError(Err,"Can't get TypeInfo from TypeLib") 
  aTypeAttributes.l 
  Err.l = oCurrentTypeInfo\GetTypeAttr(@aTypeAttributes) 
  CheckFatalError(Err,"Can't get TypeAttributes from TypeInfo") 
  *oTypeAttributes.TYPEATTR=aTypeAttributes 
  If *oTypeAttributes\typekind=#TKIND_DISPATCH Or *oTypeAttributes\typekind=#TKIND_INTERFACE 
    Err.l = StringFromCLSID_(*oTypeAttributes\guid,@IIDwStr) 
    CheckFatalError(Err,"Not a valid IDD") 
    IIDbStr.s=Uni2Ansi(IIDwStr) 
    GetDataSection("IID_"+InterfaceID,IIDbStr)
    Nr.l=*oTypeAttributes\cFuncs 
    hRefType.l 
    Err.l=oCurrentTypeInfo\GetRefTypeOfImplType(-1,@hRefType) 
    CheckError(Err,"No custom Vtable interface, choose dispinterface") 
    Err.l=oCurrentTypeInfo\GetRefTypeInfo(hRefType,@oCurrentTypeInfo.ITypeInfo) 
    CheckError(Err,"No custom Vtable interface, choose dispinterface") 
    Nr=Nr-7 
    ExtendStr.s=" Extends IDispatch" 

    If Nr>0 
        WriteStringN("Interface "+InterfaceID+ExtendStr)
    EndIf 
    For I = 0 To Nr-1 
      Err.l = oCurrentTypeInfo\GetFuncDesc(I, @aFuncDesc.l) 
      CheckFatalError(Err,"Can't Function Description from TypeInfo") 
      *oFuncDesc.FUNCDESC=aFuncDesc 
      MemberID=*oFuncDesc\memid 
      NrOfParams.l=*oFuncDesc\cParams 
      NrOfParamsOpt.l=*oFuncDesc\cParamsOpt 
      InvokeKind.l=*oFuncDesc\invokekind 
      Err.l = oCurrentTypeInfo\GetDocumentation(memberID, @bstrMethod, #Null, #Null, #Null) 
      pTypeInfo.l=oCurrentTypeInfo 
       
      STRCOMMethod.s="";stringCOMMethod(*oFuncDesc, pTypeInfo) Commented because it crashes with WriteStringN below
      
      PreFix.s="" 
      Select InvokeKind 
        Case #INVOKE_PROPERTYGET 
          PreFix.s="get_" 
        Case #INVOKE_PROPERTYPUT 
          PreFix.s="put_" 
        Case #INVOKE_PROPERTYPUTREF 
          PreFix.s="put_" 
      EndSelect 
      Err.l = oCurrentTypeInfo\GetDocumentation(memberID, @bstrMethod, #Null, #Null, #Null) 
      function.s = "  "+Prefix+ByteStr(bstrMethod)+"("+Mid(Left(Params,NrOfParams*4),2,100)+")"
      Debug function
      WriteStringN(function+" ; "+STRCOMMethod)
    Next 

    If Nr>0 
        WriteStringN("EndInterface")
        WriteStringN("")
    EndIf 
  EndIf  
EndProcedure  

WordLib.s = "{00020905-0000-0000-C000-000000000046}"
Int_Str.s = InputRequester("Interface Generator", "Enter the required interface", "")
If SaveFile()
  LoadTypeLib(wordlib)
  AnalyseTypeLib(Int_Str)
;  CloseFile() not used because opened with #PB_Any
EndIf

End

May be you have some tips to improve this.

[Fred]

Sounds cool.. About the resident, you just have to group all the interfaces in one or several files and use the command line compiler like this:

pbcompiler office.pb /RESIDENT Office.res

it should compile the file and create a resident out of it.

Is it possible to list all the available interfaces and do it all in once ?

[aXend]

I've been able to create a file with all the interfaces and all the enumerations in it. If I try to compile it to a resident, I get an error that says: "Interface or Structere expected after Extends". It points at the first definition of the _Appliction interface.

I defined:

Code: Select all

Interface _Application Extends IDispatch

It looks like it that IDispatch is unknown to the commandline compiler. How can I solve that?

[NoahPhense]

Sounds cool.. About the resident, you just have to group all the interfaces in one or several files and use the command line compiler like this:

pbcompiler office.pb /RESIDENT Office.res

it should compile the file and create a resident out of it.

Is it possible to list all the available interfaces and do it all in once ?

What exactly are the .res files, and what makes them beneficial?

- np

[Fred]

The resident are a cache for structures, interfaces and constant to avoid declaring them (or include them in every project) and makes the compilation much faster.

About the resident problem, I need to flush all the current residents to create another one, else it could have dependencies issue when loading one. So you could redefine the few interfaces needed (IDispatch -> IDispatchOffice, IUnknowOffice). About the excel one, we need to use a prefix (or anything) to avoid name clash, as both has an 'Application' interface IIRC. May be W(ord), (e)X(cel), P(owerpoint) etc.. prefix ?

[fweil]

,

I am fretting because trying to reuse aXend good work for doing something about Excel ...

So if you, Fred, prepare the apropriate stuff soon, it will be easier for me to access all Office parts using Interfaces.

I am fond of seeing this soon ... or maybe I will try to do part of it in the meanwhile.

[aXend]

@Fred: I'll prefix all the Interfaces as you suggested. I'll use the following prefixes:

• wd for Word
  xl for Excel
  pp for PowerPoint
  ol for Outlook
  ac for Access

I use the prefixes that Microsoft uses for the enumerations. I'll also define an alternative for IDispatch.

@fweil: I've improved the interface generator so it generates both enumerations and interfaces of one typelib in one run. I'm able to create an Excel version in no time.

I think it works best to have separate res-files for the Office applications, at least in the beginning. May be later I can make a complete Office.res.

[fweil]

aXend,

UR a good guy for me !

I will watch your next posts. And I will find a way to reward you anyway.

Rgrds

[aXend]

I'm surprised myself, but it worked! You can download resident files for MSWord en MSExcel at the following links:

http://home.planet.nl/~aXend/purebasic/MSWord.zip
http://home.planet.nl/~aXend/purebasic/MSExcel.zip

I hope it works for you too.

I have the following comments.

• 1. I used Office 2003 as basis for the residents
  2. You have to define the CLSID for MSWord/MSExcel and the IID for the Application Object of MSWord/MSExcel yourself, for use in CoInitialize().
  3. In the residents are all the enumerations included that Microsoft uses in there documentes. You don't have to define them yourself, you can use them easily.
  4. For information see the following links.

http://msdn.microsoft.com/library/en-us ... cation.asp
http://msdn.microsoft.com/library/en-us ... cation.asp

If you have any question or comment you let me know. Good luck

[fweil]

Thanx so much for UR efforts ... I will test that tomorrow morning and let you know.

Really good jump start for me, because I would not have been good enough to understand these interfacing coding.

KRgrds