Function

GetXMLFromWord

Module

uTemplates

Last Modified

7/15/2014 3:26:44 PM

Scope

Interfaced

Declaration

function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean;

Calls Hierarchy


GetXMLFromWord
 ├StartImportMessage
 │ └TfrmBase508Form.Create
 │   ├TfrmBase508Form.UpdateAccessibilityActions
 │   ├UnfocusableControlEnter
 │   └AdjustControls
 │     ├TfrmBase508Form.ModifyUnfocusableControl
 │     └..(rec)..
 ├BadTemplateName
 ├AddXMLData
 ├UpdateImportMessage
 ├AddBoiler
 ├AddFieldHeader
 │ └AddField
 ├AddField
 ├WordWrap
 ├AddXMLList
 │ └ListTemplateFields
 │   └GetTemplateField
 │     ├LoadTemplateFieldByIEN
 │     ├LoadTemplateField
 │     └TTemplateField.Create
 │       ├TemplateFieldCode2Field
 │       └TemplateDateCode2DateType
 ├FMNow
 ├WordImportError
 └StopImportMessage

Called-By Hierarchy


                             GetXMLFromWord
TfrmTemplateEditor.mnuImportTemplateClick┘ 

Calls

Name Declaration Comments
AddBoiler procedure AddBoiler(txt: string); -
AddField procedure AddField(Typ: TTemplateFieldExportField; Value: string; Pending: boolean = FALSE); -
AddFieldHeader procedure AddFieldHeader(FldType: TTemplateFieldType; First: boolean); -
AddXMLData procedure AddXMLData(Data: TStrings; const Pad: string; FldType: TTemplateExportField; const Value, DefValue: string); -
AddXMLList procedure AddXMLList(Data, Fields: TStrings; const Pad: string; FldType: TTemplateExportField; Const Txt: string); -
BadTemplateName function BadTemplateName(Text: string): boolean; -
FMNow function FMNow: TFMDateTime; -
StartImportMessage procedure StartImportMessage(AFileName: string; MaxCount: integer); -
StopImportMessage procedure StopImportMessage; -
UpdateImportMessage function UpdateImportMessage(CurrentCount: integer): boolean; -
WordImportError procedure WordImportError(msg: string); -
WordWrap procedure WordWrap(var Str: string); -

Called-By

Name Declaration Comments
TfrmTemplateEditor.mnuImportTemplateClick procedure mnuImportTemplateClick(Sender: TObject); -


Source

1086  function GetXMLFromWord(const AFileName: string; Data: TStrings): boolean;
1087  var
1088    itmp, itmp2, itmp3, i, j: integer;
1089    WDoc: TWordDocument;
1090    WasVis: boolean;
1091    WApp: TWordApplication;
1092    Boiler: string;
1093    FldCache, Fields, PendingAdd: TStringList;
1094    OldCur: TCursor;
1095    idx, TmpVar, RangeStart, RangeEnd: oleVariant;
1096    ddTotal, ffTotal, ffStartCur, ffEndCur, ffEndLast : integer;
1097    ffRange, textRange: Range;
1098    tmp, TemplateName, fName: string;
1099    tmpType, tfIdx: TTemplateFieldType;
1100    tmpDate: TTmplFldDateType;
1101  
1102    tfCount: array[TTemplateFieldType] of integer;
1103  
1104    procedure AddBoiler(txt: string);
1105    var
1106      i: integer;
1107      c: char;
1108      tmp: string;
1109  
1110    begin
1111      tmp := '';
1112      for i := 1 to length(txt) do
1113      begin
1114        c := txt[i];
1115        if (c > #31) or (c = #13) or (c = #10) then
1116          tmp := tmp + c;
1117      end;
1118      Boiler := Boiler + tmp;
1119    end;
1120  
1121    procedure AddField(Typ: TTemplateFieldExportField; Value: string; Pending: boolean = FALSE);
1122    var
1123      sl: TStringList;
1124  
1125    begin
1126      if Pending then
1127        sl := PendingAdd
1128      else
1129        sl := Fields;
1130      sl.Add('<' + TemplateFieldExportTag[Typ] + '>' + Text2XML(Value) +
1131                      '</' + TemplateFieldExportTag[Typ] + '>');
1132    end;
1133  
1134    procedure AddFieldHeader(FldType: TTemplateFieldType; First: boolean);
1135    var
1136      tmp: string;
1137  
1138    begin
1139      tmp := '<';
1140      if not First then
1141        tmp := tmp + '/';
1142      tmp := tmp + XMLFieldTag;
1143      if First then
1144      begin
1145        fname := 'WORDFLD_' + FldNames[FldType] + '_';
1146        tfIdx := FldType;
1147        tmp := tmp + ' ' + TemplateFieldExportTag[tfName] + '="' + Text2XML(fname);
1148      end;
1149      if not First then
1150        tmp := tmp + '>';
1151      Fields.Add(tmp);
1152      if First then
1153        AddField(tfType, TemplateFieldTypeCodes[FldType]);
1154    end;
1155  
1156    procedure WordWrap(var Str: string);
1157    var
1158      TmpSL: TStringList;
1159      i: integer;
1160  
1161    begin
1162      TmpSL := TStringList.Create;
1163      try
1164        TmpSL.Text := Str;
1165        Str := '';
1166        for i := 0 to TmpSL.Count-1 do
1167        begin
1168          if Str <> '' then
1169            Str := Str + CRLF;
1170          Str := Str + WrapText(TmpSL[i], #13#10, [' ','-'], MAX_ENTRY_WIDTH);
1171        end;
1172      finally
1173        TmpSL.Free;
1174      end;
1175    end;
1176  
1177  begin
1178    for tfIdx := low(TTemplateFieldType) to high(TTemplateFieldType) do
1179      tfCount[tfIdx] := 1;
1180    TemplateName := ExtractFileName(AFileName);
1181    Result := TRUE;
1182    try
1183      OldCur := Screen.Cursor;
1184      Screen.Cursor := crAppStart;
1185      try
1186        WApp := TWordApplication.Create(nil);
1187        try
1188          WasVis := WApp.Visible;
1189          WApp.Visible := FALSE;
1190          try
1191            WDoc := TWordDocument.Create(nil);
1192            try
1193              try
1194                WApp.Connect;
1195                TmpVar := AFileName;
1196                {$IFDEF VER140}
1197                WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam));
1198                {$ELSE}
1199                WDoc.ConnectTo(WApp.Documents.Add(TmpVar, EmptyParam, EmptyParam, EmptyParam));
1200                {$ENDIF}
1201                ffTotal := WDoc.FormFields.Count;
1202  
1203                if ffTotal > 3 then
1204                  StartImportMessage(TemplateName, ffTotal+1);
1205  
1206                if WDoc.ProtectionType <> wdNoProtection then
1207                  WDoc.Unprotect;
1208  
1209                Data.Add('<'+XMLHeader+'>');
1210  
1211                tmp := ExtractFileExt(TemplateName);
1212                if tmp <> '' then
1213                begin
1214                  i := pos(tmp,TemplateName);
1215                  if i > 0 then
1216                    delete(TemplateName, i, length(tmp));
1217                end;
1218                TemplateName := copy(TemplateName, 1, 60);
1219  
1220                if BadTemplateName(TemplateName) then
1221                begin
1222                  tmp := copy('WordDoc ' + TemplateName, 1, 60);
1223                  if BadTemplateName(TemplateName) then
1224                    tmp := 'Imported Word Document'
1225                  else
1226                    tmp := TemplateName;
1227                end
1228                else
1229                  tmp := TemplateName;
1230                Data.Add('<' + XMLTemplateTag + ' ' + TemplateExportTag[efName] + '="' + Text2XML(tmp) + '">');
1231                AddXMLData(Data, '', efType, TemplateTypeCodes[ttDoc], '');
1232                AddXMLData(Data, '', efStatus, TemplateActiveCode[TRUE], '');
1233  
1234                Boiler := '';
1235                Fields := TStringList.Create;
1236                try
1237                  FldCache := TStringList.Create;
1238                  try
1239                    PendingAdd := TStringList.Create;
1240                    try
1241                      ffEndCur := 0;
1242  
1243                      for i := 1 to ffTotal do
1244                      begin
1245                        if UpdateImportMessage(i) then
1246                        begin
1247                          Result := FALSE;
1248                          Data.Clear;
1249                          break;
1250                        end;
1251                        idx := i;
1252                        ffEndLast := ffEndCur;
1253                        ffRange := WDoc.FormFields.Item(idx).Range;
1254                        ffStartCur := ffRange.Start;
1255                        ffEndCur := ffRange.End_;
1256  
1257                        // Assign working start range for text collection:
1258                        if i = 1 then
1259                          rangeStart := 0 // Before first FormField, use start of document.
1260                        else
1261                          rangeStart := ffEndLast; // Start of new range is end of the last FormField range.
1262  
1263                        // Assign working end range for text collection:
1264                        rangeEnd := ffStartCur; // End of new range is start of current FormField range.
1265  
1266                        // Collect text in the range:
1267                        textRange := WDoc.Range(rangeStart, rangeEnd);
1268                        textRange.Select;
1269  
1270                        AddBoiler(TextRange.text);
1271                        tfIdx := dftUnknown;
1272                        fname := '';
1273                        case WDoc.FormFields.Item(idx).type_ of
1274                          wdFieldFormTextInput:
1275                            begin
1276                              itmp3 := WDoc.FormFields.Item(idx).TextInput.Type_;
1277                              case itmp3 of
1278                                wdNumberText: tmpType := dftNumber;
1279                                wdDateText, wdCurrentDateText, wdCurrentTimeText: tmpType := dftDate;
1280                                else tmpType := dftEditBox;
1281                              end;
1282                              AddFieldHeader(tmpType, TRUE);
1283                              tmpDate := dtUnknown;
1284                              tmp := WDoc.FormFields.Item(idx).TextInput.Default;
1285                              case itmp3 of
1286                                wdNumberText:
1287                                  begin
1288                                    AddField(tfMinVal, IntToStr(-9999), TRUE);
1289                                    AddField(tfMaxVal, IntToStr(9999), TRUE);
1290                                  end;
1291  
1292                                wdDateText: tmpDate := dtDate;
1293                                wdCurrentDateText:
1294                                  begin
1295                                    tmpDate := dtDate;
1296                                    if tmp = '' then
1297                                      tmp := 'T';
1298                                  end;
1299                                wdCurrentTimeText:
1300                                  begin
1301                                    tmpDate := dtDateTime;
1302                                    if tmp = '' then
1303                                      tmp := 'NOW';
1304                                  end;
1305                                else
1306                                  begin
1307                                    itmp2 := WDoc.FormFields.Item(idx).TextInput.Width;
1308                                    itmp := itmp2;
1309                                    if (itmp < 1) then
1310                                    begin
1311                                      itmp := length(tmp);
1312                                      if itmp < 10 then
1313                                        itmp := 10
1314                                      else
1315                                      if itmp > 70 then
1316                                        itmp := 70;
1317                                      itmp2 := 240;
1318                                    end
1319                                    else
1320                                    begin
1321                                      if (itmp > 70) then
1322                                        itmp := 70;
1323                                      if (itmp2 > 240) then
1324                                        itmp2 := 240;
1325                                    end;
1326                                    AddField(tfLength, IntToStr(itmp));
1327                                    AddField(tfTextLen, IntToStr(itmp2), TRUE);
1328                                  end;
1329                              end;
1330                              if tmpDate <> dtUnknown then
1331                                AddField(tfDateType, TemplateFieldDateCodes[tmpDate], TRUE);
1332                              if tmp <> '' then
1333                                AddField(tfDefault, tmp);
1334                              FastAddStrings(PendingAdd, Fields);
1335                              PendingAdd.Clear;
1336                              AddFieldHeader(tmpType, FALSE);
1337                            end;
1338  
1339                          wdFieldFormCheckBox:
1340                            begin
1341                              AddFieldHeader(dftButton, TRUE);
1342                              itmp := ord(boolean(WDoc.FormFields.Item(idx).CheckBox.Default))+1;
1343                              AddField(tfDefIdx, IntToStr(itmp));
1344                              Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>');
1345                              Fields.Add('<p>' + Text2XML('[ ]') + '</p>');
1346                              Fields.Add('<p>' + Text2XML('[X]') + '</p>');
1347                              Fields.Add('</' + TemplateFieldExportTag[tfItems] + '>');
1348                              AddFieldHeader(dftButton, FALSE);
1349                            end;
1350  
1351                          wdFieldFormDropDown:
1352                            begin
1353                              ddTotal := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Count;
1354                              if(ddTotal > 0)then
1355                              begin
1356                                AddFieldHeader(dftComboBox, TRUE);
1357                                itmp := WDoc.FormFields.Item(idx).DropDown.Default;
1358                                if itmp > 0 then
1359                                  AddField(tfDefIdx, IntToStr(itmp));
1360  
1361                                Fields.Add('<' + TemplateFieldExportTag[tfItems] + '>');
1362                                for j := 1 to ddTotal do
1363                                begin
1364                                  TmpVar := j;
1365                                  tmp := WDoc.FormFields.Item(Idx).DropDown.ListEntries.Item(TmpVar).Name;
1366                                  Fields.Add('<p>' + Text2XML(tmp) + '</p>');
1367                                end;
1368                                Fields.Add('</' + TemplateFieldExportTag[tfItems] + '>');
1369                                AddFieldHeader(dftComboBox, FALSE);
1370                              end;
1371                            end;
1372                        end;
1373                        if (Fields.Count > 0) then
1374                        begin
1375                          if tfIdx <> dftUnknown then
1376                          begin
1377                            tmp := Fields.CommaText;
1378                            j := FldCache.IndexOf(tmp);
1379                            if j < 0 then
1380                            begin
1381                              FldCache.AddObject(tmp, TObject(tfCount[tfIdx]));
1382                              j := tfCount[tfIdx];
1383                              inc(tfCount[tfIdx]);
1384                            end
1385                            else
1386                              j := Integer(FldCache.Objects[j]);
1387                            Boiler := Boiler + TemplateFieldBeginSignature + fname + IntToStr(j) + TemplateFieldEndSignature;
1388                          end;
1389                          Fields.Clear;
1390                        end;
1391                      end;
1392                      if Result then
1393                      begin
1394                        rangeStart := ffEndCur; // Start of new range is end of last FormField range.
1395                        rangeEnd := WDoc.Range.End_; // After last FormField, use end of document.
1396  
1397                        // Collect text in trailing range:
1398                        textRange := WDoc.Range(rangeStart, rangeEnd);
1399                        textRange.Select;
1400  
1401                        AddBoiler(TextRange.text);
1402  
1403                        WordWrap(Boiler);
1404  
1405                        AddXMLList(Data, nil, '', efBoilerplate, Boiler);
1406  
1407                        tmp := WrapText('Imported on ' + FormatFMDateTime('mmm dd yyyy hh:nn', FMNow) +
1408                                        ' from Word Document: ' + AFileName, #13#10, [' '], MAX_ENTRY_WIDTH);
1409  
1410                        AddXMLList(Data, nil, '', efDescription, tmp);
1411  
1412                        Data.Add('</' + XMLTemplateTag + '>');
1413                        if FldCache.Count > 0 then
1414                        begin
1415                          Data.Add('<' + XMLTemplateFieldsTag + '>');
1416                          for i := 0 to FldCache.Count-1 do
1417                          begin
1418                            Fields.Clear;
1419                            Fields.CommaText := FldCache[i];
1420                            if Fields.Count > 0 then
1421                            begin
1422                              Fields[0] := Fields[0] + IntToStr(Integer(FldCache.Objects[i])) + '">';
1423                              FastAddStrings(Fields, Data);
1424                            end;
1425                          end;
1426                          Data.Add('</' + XMLTemplateFieldsTag + '>');
1427                        end;
1428  
1429                        Data.Add('</'+XMLHeader+'>');
1430                        UpdateImportMessage(ffTotal+1);
1431                      end;
1432                    finally
1433                      PendingAdd.Free;
1434                    end;
1435                  finally
1436                    FldCache.Free;
1437                  end;
1438                finally
1439                  Fields.Free;
1440                end;
1441  
1442              except
1443                on E:Exception do
1444                  WordImportError(E.Message);
1445              end;
1446            finally
1447              TmpVar := wdDoNotSaveChanges;
1448              WDoc.Close(TmpVar);
1449              WDoc.Free;
1450            end;
1451          finally
1452            WApp.Visible := WasVis;
1453          end;
1454        finally
1455          WApp.Disconnect;
1456          WApp.Free;
1457        end;
1458      finally
1459        Screen.Cursor := OldCur;
1460      end;
1461    finally
1462      StopImportMessage;
1463    end;
1464    if not Result then
1465      InfoBox('Importing Word Document Canceled.','Import Canceled', MB_OK);
1466  end;