[x]
Posted via EE Mobile

Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.
Question
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.3

Why does this code not compile on Delphi 2010 (compiles on Delphi 2009)?

Asked by FALECoder in Delphi Programming, Delphi Curiosities, Delphi IDE

Tags: Delphi 2010, Delphi 2009, compile, error

Hi!
I've been using Delphi 2009 and am now testing Delphi 2010. When trying to compile a project, for some reason I get a "Missing operator or semicolon" error in the file attached, and can't understand why this happens. It compiles fine on Delphi 2009 and I thought there shouldn't really be many code changes between 2009 and 2010 (still remembering with a shudder the migration process from Delphi 7 to Delphi 2009 with the Unicodes and was hoping this to be smooth...). The entire problematic unit is attached below (error comes on line 266) and to reproduce the problem no other units seem to be needed. Screenshot of error is also attached. Any help would be appreciated - is this something caused by Delphi 2010 or am I missing something obvious?

Thanks! 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:

unit ExRegistry;
 
interface
 
uses windows, classes, sysutils, registry;
 
type
 
TWalkProc = procedure (const keyName, valueName : string; dataType : DWORD; data : pointer; DataLen : Integer) of object;
 
TSearchParam = (rsKeys, rsValues, rsData);
TSearchParams = set of TSearchParam;
 
TSearchNode = class
  fValueNames : TStringList;
  fKeyNames : TStringList;
  fCurrentKey : string;
  fPath: string;
  fValueIDX, fKeyIDX : Integer;
  fRegRoot : HKEY;
  constructor Create (ARegRoot : HKEY; const APath : string);
  destructor Destroy; override;
 
  procedure LoadKeyNames;
  procedure LoadValueNames;
end;
 
TExRegistry = class (TRegistry)
private
  fSaveServer : string;
  fExportStrings : TStrings;
  fLastExportKey : string;
  fSearchParams : TSearchParams;
  fSearchString : string;
  fSearchStack : TList;
  fMatchWholeString : boolean;
  fCancelSearch : boolean;
  fLocalRoot : HKEY;
  fValuesSize : Integer;
  procedure ExportProc (const keyName, valueName : string; dataType : DWORD; data : pointer; DataLen : Integer);
  procedure ValuesSizeProc (const keyName, valueName : string; dataType : DWORD; data : pointer; DataLen : Integer);
  procedure ClearSearchStack;
 
public
  destructor Destroy; override;
  procedure SetRoot (root : HKey; const server : string);
  procedure CopyValueFromReg (const valueName : string; otherReg : TExRegistry; deleteSource : boolean);
  procedure CopyKeyFromReg (const keyName : string; otherReg : TExRegistry; deleteSource : boolean);
  function GetValueType (const valueName : string) : DWORD;
  procedure ReadStrings (const valueName : string; strings : TStrings);
  procedure WriteStrings (const valueName : string; strings : TStrings);
  procedure ExportKey (const fileName : string);
  procedure ImportRegFile (const fileName : string; Stream : TStream = nil);
  procedure WriteTypedBinaryData (const valueName : string; tp : Integer; var data; size : Integer);
  procedure Walk (walkProc : TWalkProc; valuesRequired : boolean);
  function FindFirst (const data : string; params : TSearchParams; MatchWholeString : boolean; var retPath, retValue : string) : boolean;
  function FindNext (var retPath, retValue : string) : boolean;
  procedure CancelSearch;
  property SearchString : string read fSearchString;
  procedure GetValuesSize (var size : Integer);
end;
 
EExRegistryException = class (ERegistryException)
private
    fCode: Integer;
    function GetError : string;
public
  constructor CreateLastError (const st : string);
  constructor Create (code : DWORD; const st : string);
  property Code : Integer read fCode;
end;
 
implementation
 
{ TExRegistry }
 
resourcestring
  errUnableToConnect = 'Unable to connect to the registry on %s (%d)';
 
type
  TRootRec = record
    key : HKEY;
    name : string
  end;
 
const
  NO_ROOT_KEYS = 7;
  RootKeys : array [0..NO_ROOT_KEYS - 1] of TRootRec = (
    (key : HKEY_CLASSES_ROOT;     name : 'HKEY_CLASSES_ROOT'),
    (key : HKEY_CURRENT_USER;     name : 'HKEY_CURRENT_USER'),
    (key : HKEY_LOCAL_MACHINE;    name : 'HKEY_LOCAL_MACHINE'),
    (key : HKEY_USERS;            name : 'HKEY_USERS'),
    (key : HKEY_PERFORMANCE_DATA; name : 'HKEY_PERFORMANCE_DATA'),
    (key : HKEY_CURRENT_CONFIG;   name : 'HKEY_CURRENT_CONFIG'),
    (key : HKEY_DYN_DATA;         name : 'HKEY_DYN_DATA'));
 
 
function RootKeyName (key : HKEY) : string;
var
  i : Integer;
begin
  result := '';
  for i := 0 to NO_ROOT_KEYS - 1 do
    if RootKeys [i].key = key then
    begin
      result := RootKeys [i].name;
      break
    end
end;
 
function RootKeyVal (const st : string) : HKEY;
var
  i : Integer;
begin
  result := $ffffffff;
  for i := 0 to NO_ROOT_KEYS - 1 do
    if RootKeys [i].name = st then
    begin
      result := RootKeys [i].key;
      break
    end
end;
 
 
procedure TExRegistry.CancelSearch;
begin
  fCancelSearch := True;
end;
 
procedure TExRegistry.ClearSearchStack;
var
  i : Integer;
begin
  if Assigned (fSearchStack) then
  begin
    for i := 0 to fSearchStack.Count - 1 do
      TSearchNode (fSearchStack [i]).Free;
    fSearchStack.Free;
    fSearchStack := Nil
  end
end;
 
procedure TExRegistry.CopyKeyFromReg(const keyName: string;
  otherReg: TExRegistry; deleteSource : boolean);
var
  i : Integer;
  values : TStringList;
  sourceReg : TExRegistry;
  destReg : TExRegistry;
begin
  sourceReg := TExRegistry.Create;
  destReg := TExRegistry.Create;
  values := TStringList.Create;
  try
    sourceReg.RootKey := otherReg.CurrentKey;
    if deleteSource then
      sourceReg.OpenKey (keyName, False)
    else
      sourceReg.OpenKeyReadOnly (keyName);
    sourceReg.GetValueNames (values);
 
    destReg.RootKey := CurrentKey;
    if destReg.OpenKey (keyName, True) then
    begin
      for i := 0 to values.Count - 1 do
        destReg.CopyValueFromReg (values [i], sourceReg, deleteSource);
 
      sourceReg.GetKeyNames (values);
      for i := 0 to values.Count - 1 do
        destReg.CopyKeyFromReg (values [i], sourceReg, deleteSource);
 
      if DeleteSource then
        if not otherReg.DeleteKey (keyName) then
          Raise ERegistryException.Create ('Unable to delete moved key')
    end
    else
      raise ERegistryException.Create ('Unable to open destination');
  finally
    values.Free;
    destReg.Free;
    sourceReg.Free
  end
end;
 
procedure TExRegistry.CopyValueFromReg(const valueName: string;
  otherReg: TExRegistry; deleteSource : boolean);
var
  buffer : PByte;
  BufSize : DWORD;
  DataType : DWORD;
begin
  BufSize := 65536;
  GetMem (buffer, BufSize);
  try
    DataType := REG_NONE;
 
    SetLastError (RegQueryValueEx(otherReg.CurrentKey, PChar(valueName), nil, @DataType, Buffer,
      @BufSize));
 
     if GetLastError <> ERROR_SUCCESS then
      raise EExRegistryException.CreateLastError ('Unable to copy value');
 
    SetLastError (RegSetValueEx (CurrentKey, PChar (valueName), 0, DataType, buffer, BufSize));
    if GetLastError <> ERROR_SUCCESS then
      raise EExRegistryException.CreateLastError ('Unable to copy value');
 
    if deleteSource then
      if not otherReg.DeleteValue (valueName) then
        raise ERegistryException.Create ('Unable to delete moved value')
  finally
    FreeMem (buffer)
  end
end;
 
 
destructor TExRegistry.Destroy;
begin
  ClearSearchStack;
  inherited Destroy
end;
 
procedure TExRegistry.ExportKey(const fileName: string);
begin
  fExportStrings := TStringList.Create;
  fExportStrings.Add ('REGEDIT4');
  try
    fLastExportKey := '';
    Walk (ExportProc, True);
    fExportStrings.Add ('');
  finally
    fExportStrings.SaveToFile (fileName);
    fExportStrings.Free;
  end
end;
 
procedure TExRegistry.ExportProc(const keyName, valueName: string;
  dataType: DWORD; data: pointer; DataLen: Integer);
 
var
  st : string;
  st1 : string;
  j : Integer;
  localRoot : HKey;
 
  function MakeCStringConst (s : string) : string;
  var
    i : Integer;
  begin
    result := '';
    for i := 1 to Length (s) do
    begin
      if CharInSet(s[i], ['\', '"']) then
        result := result + '\';
      result := result + s[i]
    end
  end;
 
begin
  localRoot := fLocalRoot;
  if localRoot = 0 then
    localRoot := RootKey;
 
  if fLastExportKey <> keyName then
  begin
    fExportStrings.Add ('');
    fExportStrings.Add (Format ('[%s\%s]', [rootKeyName (localRoot), keyName]));
 
    fLastExportKey := keyName;
  end;
 
  if dataLen <> 0 then
  begin
    if valueName = '' then
      st := '@='
    else
      st := Format ('"%s"=', [MakeCStringConst (valueName)]);
 
    case dataType of
      REG_DWORD :
      begin
        st1 := LowerCase (Format ('%8.8x', [PDWORD (data)^]));
        st := st + format ('dword:%s', [st1])
      end;
 
      REG_SZ    :
        begin
          PChar (data) [dataLen] := #0;
          st := st + format ('"%s"', [MakeCStringConst (PChar (data))]);
        end;
 
      else
      begin
        if dataType = REG_BINARY then
          st := st + 'hex:'
        else
          st := st + format ('hex(%d):', [dataType]);
        for j := 0 to dataLen - 1 do
        begin
          st1 := LowerCase (format ('%02.2x', [Byte (PChar (data) [j])]));
          if j < dataLen - 1 then
            st1 := st1 + ',';
 
          if Length (st) + Length (st1) >= 77 then
          begin
            fExportStrings.Add (st + st1 + '\');
            st := '  ';
          end
          else
            st := st + st1;
        end
      end
    end;
    fExportStrings.Add (st);
  end
end;
 
function TExRegistry.FindFirst(const data: string; params: TSearchParams; MatchWholeString : boolean;
  var retPath, retValue: string): boolean;
var
  path, nPath, keyName : string;
  p : Integer;
  n : TSearchNode;
begin
  ClearSearchStack;
 
  fSearchStack := TList.Create;
  path := currentPath;
 
 
  nPath := '';
  repeat
    p := Pos ('\', path);
    if p > 0 then
    begin
      nPath := nPath + '\' + Copy (path, 1, p - 1);
      path := Copy (path, p + 1, MaxInt);
      n := TSearchNode.Create (RootKey, nPath);
      n.LoadKeyNames;
      p := Pos ('\', path);
      if p > 0 then
        keyName := Copy (path, 1, p - 1)
      else
        keyName := path;
 
      n.fKeyIDX := n.fKeyNames.IndexOf (keyName);
 
      fSearchStack.Add (n);
    end
  until p = 0;
 
  n := TSearchNode.Create (RootKey, nPath + '\' + path);
  fSearchStack.Add (n);
 
  fSearchString := UpperCase (data);
  fSearchParams := params;
  fMatchWholeString := MatchWholeString;
  result := FindNext (retPath, retValue);
end;
 
function TExRegistry.FindNext(var retPath, retValue: string): boolean;
var
  n : TSearchNode;
  found : boolean;
  k : string;
  msg : TMsg;
begin
  found := False;
  fCancelSearch := False;
  while (not found) and (not fCancelSearch) and (fSearchStack.Count > 0) do
  begin
    while PeekMessage (msg, 0, 0, 0, PM_REMOVE) do
    begin
      TranslateMessage (msg);
      DispatchMessage (msg)
    end;
 
    n := TSearchNode (fSearchStack [fSearchStack.Count - 1]);
    if rsValues in fSearchParams then
    begin
      n.LoadValueNames;
      with n do
        if fValueIdx < fValueNames.Count then
        repeat
          Inc (fValueIdx);
          if fValueIdx < fValueNames.Count then
          begin
            if fMatchWholeString then
              found := fSearchString = fValueNames [fValueIdx]
            else
              found := Pos (fSearchString, fValueNames [fValueIdx]) > 0
          end
        until fCancelSearch or found or (fValueIdx = fValueNames.Count)
    end;
 
    if not fCancelSearch and not found then
    begin
      n.LoadKeyNames;
      with n do
        if fKeyIdx < fKeyNames.Count then
        begin
          Inc (fKeyIdx);
          if fKeyIdx < fKeyNames.Count then
          begin
 
            if rsKeys in fSearchParams then
              if fMatchWholeString then
                found := fSearchString = fKeyNames [fKeyIdx]
              else
                found := Pos (fSearchString, fKeyNames [fKeyIdx]) > 0;
 
            if not found then
            begin
              if n.fPath = '\' then
                k := '\' + fKeyNames [fKeyIdx]
              else
                k := n.fPath + '\' + fKeyNames [fKeyIdx];
 
              fSearchStack.Add (TSearchNode.Create (RootKey, k));
 
              continue
            end
          end
      end
    end;
 
    if fCancelSearch then
      Break;
 
    if not found then
    begin
      n.Free;
      fSearchStack.Delete (fSearchStack.Count - 1)
    end
    else
    begin
      retPath := n.fPath;
      if n.fKeyIdx > -1 then
        retPath := retPath + '\' + n.fKeyNames [n.fKeyIdx];
 
      if rsValues in fSearchParams then
        if (n.fValueIdx > -1) and (n.fValueIdx < n.fValueNames.Count) then
          retValue := n.fValueNames [n.fValueIdx]
        else
          retValue := '';
    end
  end;
  result := found
end;
 
procedure TExRegistry.GetValuesSize(var size: Integer);
begin
  fValuesSize := 0;
  Walk (ValuesSizeProc, False);
  if fValuesSize = 0 then
    fValuesSize := -1;
  size := fValuesSize
end;
 
function TExRegistry.GetValueType(const valueName: string): DWORD;
var
  valueType : DWORD;
begin
  SetLastError (RegQueryValueEx (CurrentKey, PChar (valueName), Nil, @valueType, Nil, Nil));
  if GetLastError = ERROR_SUCCESS then
    result := valueType
  else
    raise EExRegistryException.CreateLastError ('Unable to get value type');
end;
 
procedure TExRegistry.ImportRegFile(const fileName: string; Stream: TStream = nil);
var
  strings : TStrings;
  st : string;
  i : Integer;
 
  procedure SyntaxError;
  begin
    raise Exception.CreateFmt ('Syntax error in reg file %s at line %d', [fileName, i])
  end;
 
  procedure CreateNewKey;
  var
    s : string;
    p : Integer;
    r : HKEY;
  begin
    Delete (st, 1, 1);
    if st [Length (st)] <> ']' then
      SyntaxError;
 
    Delete (st, Length (st), 1);
 
    p := pos ('\', st);
    if p = 0 then
      SyntaxError;
    s := Copy (st, 1, p - 1);
    st := Copy (st, p + 1, MaxInt);
 
    if st = '' then
      SyntaxError;
 
    r := RootKeyVal (s);
    if r = $ffffffff then
      SyntaxError;
 
    SetRoot (r, fSaveServer);
    OpenKey ('\' + st, True)
  end;
 
  function GetCString (const st : string) : string;
  var
    i : Integer;
  begin
    result := '';
    i := 2;
    while i <= Length (st) - 1 do
    begin
      if st [i] = '\' then
        Inc (i);
 
      if i <= Length (st) - 1 then
        result := result + st [i];
 
      Inc (i)
    end
  end;
 
  function GetBinaryBuffer (const st : string) : string;
  var
    i : Integer;
    val : string;
  begin
    i := 1;
    result := '';
    while i <= Length (st) do
    begin
      if CharInSet(st[i], ['0'..'9', 'a'..'f', 'A'..'F']) then
        val := val + st [i]
      else
      begin
        if val <> '' then
        begin
          result := result + chr (StrToInt ('$' + val));
          val := ''
        end
      end;
 
      Inc (i)
    end
  end;
 
  procedure CreateNewValue;
  var
    s : string;
    fn : string;
    p : Integer;
    tp : Integer;
    buf : string;
  begin
    if st [1] = '"' then
    begin
      Delete (st, 1, 1);
      p := Pos ('"', st);
      if p = 0 then
        SyntaxError;
 
      s := Copy (st, 1, p - 1);
      st := Copy (st, p + 1, MaxInt)
    end
    else
    begin
      Delete (st, 1, 1);
      s := ''
    end;
 
    st := TrimLeft (st);
 
    if st = '' then
      SyntaxError;
 
    if st [1] <> '=' then
      SyntaxError;
 
    Delete (st, 1, 1);
 
    st := TrimLeft (st);
 
    if st [1] = '"' then
      WriteString (s, GetCString (st))
    else
    begin
      p := 1;
      while (p <= Length (st)) and not (CharInSet(st[p], [':', '(', ' '])) do
        Inc (p);
 
      fn := Copy (st, 1, p - 1);
 
      st := TrimLeft (Copy (st, p, MaxInt));
 
      if CompareText (fn, 'hex') = 0 then
      begin
        tp := 3;
        if st [1] = '(' then
        begin
          Delete (st, 1, 1);
          fn := '';
          p := 1;
          while (p <= Length (st)) and (st [p] <> ')') do
          begin
            fn := fn + st [p];
            Inc (p)
          end;
 
          tp := StrToInt (fn);
          st := Trim (Copy (st, p + 1, MaxInt));
        end;
 
        if st [1] <> ':' then
          SyntaxError;
 
        Delete (st, 1, 1);
 
        buf := GetBinaryBuffer (st);
 
        WriteTypedBinaryData (s, tp, PChar (buf)^, Length (buf));
      end
      else
        if CompareText (fn, 'dword') = 0 then
        begin
          if st [1] <> ':' then
            SyntaxError;
 
          Delete (st, 1, 1);
          WriteInteger (s, StrToInt ('$' + TrimLeft (st)))
        end
        else
          SyntaxError
    end
  end;
 
begin
  strings := TStringList.Create;
  try
    if Stream <> nil then
      strings.LoadFromStream (Stream)
    else
      strings.LoadFromFile (fileName);
 
    while (strings.Count > 0) do
    begin
      st := Trim (strings [0]);
      if (st = '') or (st [1] = ';') then
        strings.Delete (0)
      else
        break
    end;
 
    if strings [0] <> 'REGEDIT4' then
      raise Exception.Create ('Bad file format.  Missing REGEDIT4 in first line.');
 
    i := 1;
    while i < strings.Count do
    begin
      st := Trim (strings [i]);
 
      if st <> '' then
        while st [Length (st)] = '\' do
        begin
          Inc (i);
          Delete (st, Length (st), 1);
          if i < strings.Count then
            st := st + strings [i]
          else
            break
        end;
 
      if (Length (st) > 0) and (st [1] <> ';') then
      begin
        case st [1] of
          '[' : CreateNewKey;
          '"' : CreateNewValue;
          '@' : CreateNewValue;
          else
            SyntaxError
        end
      end;
 
      Inc (i)
    end
  finally
    strings.Free
  end
end;
 
procedure TExRegistry.ReadStrings(const valueName: string;
  strings: TStrings);
var
  valueType : DWORD;
  valueLen : DWORD;
  p, buffer : PChar;
begin
  strings.Clear;
  SetLastError (RegQueryValueEx (CurrentKey, PChar (valueName), Nil, @valueType, Nil, @valueLen));
  if GetLastError = ERROR_SUCCESS then
    if valueType = REG_MULTI_SZ then
    begin
      GetMem (buffer, valueLen);
      try
        RegQueryValueEx (CurrentKey, PChar (valueName), Nil, Nil, PBYTE (buffer), @valueLen);
        p := buffer;
        while p^ <> #0 do
        begin
          strings.Add (p);
          Inc (p, lstrlen (p) + 1)
        end
      finally
        FreeMem (buffer)
      end
    end
    else
      raise ERegistryException.Create ('String list expected')
  else
    raise EExRegistryException.CreateLastError ('Unable read MULTI_SZ value')
end;
 
procedure TExRegistry.SetRoot(root: HKey; const server: string);
begin
  fSaveServer := server;
  RootKey := root;
  fLocalRoot := root;
  if server <> '' then
    if not RegistryConnect ('\\' + server) then
      Raise Exception.CreateFmt (errUnableToConnect, [server, GetLastError])
end;
 
procedure TExRegistry.ValuesSizeProc(const keyName, valueName: string;
  dataType: DWORD; data: pointer; DataLen: Integer);
begin
  Inc (fValuesSize, DataLen);
end;
 
procedure TExRegistry.Walk(walkProc: TWalkProc; valuesRequired : boolean);
 
var
  defaultValue : array [0..256] of char;
  defaultValueLen : DWORD;
 
  valueName : array [0..256] of char;
  valueNameLen : DWORD;
 
  keyName : array [0..256] of char;
 
  cValues : DWORD;
  tp : DWORD;
 
  buffer : PChar;
  bufSize : DWORD;
 
  valueLen, maxValueLen : DWORD;
  keyLen : DWORD;
 
  procedure DoWalk (const pathName : string);
  var
    k : HKEY;
    err : Integer;
    i : Integer;
    cSubKeys : DWORD;
  begin
    err := RegOpenKeyEx (RootKey, PChar (pathName), 0, KEY_READ, k);
    if err = ERROR_SUCCESS then
    try
      defaultValueLen := sizeof (defaultValue);
 
      err := RegQueryInfoKey (k, defaultValue, @defaultValueLen, Nil, @cSubkeys, Nil, Nil, @cValues, nil, @maxValueLen, nil, nil);
      if (err <> ERROR_SUCCESS) and (err <> ERROR_ACCESS_DENIED) then
        raise EExRegistryException.Create (err, 'Unable to query key info');
 
      if err = ERROR_SUCCESS then
      begin
        if cValues > 0 then
        begin
          if maxValueLen > bufSize then
          begin
            bufSize := 65536 * ((maxValueLen + 65536) div 65536);
            ReallocMem (buffer, bufSize)
          end;
 
          for i := 0 to cValues - 1 do
          begin
            valueNameLen := sizeof (valueName);
            valueLen := maxValueLen;
            if valuesRequired then
              err := RegEnumValue (k, i, valueName, valueNameLen, Nil, @tp, PByte (buffer), @valueLen)
            else
              err := RegEnumValue (k, i, valueName, valueNameLen, Nil, @tp, Nil, @valueLen);
            if err <> ERROR_SUCCESS then
              raise EExRegistryException.Create (err, 'Unable to get value info');
 
            walkProc (pathName, valueName, tp, buffer, valueLen);
          end
        end
        else
          walkProc (pathName, '', 0, Nil, 0);
 
        for i := 0 to cSubkeys - 1 do
        begin
          keyLen := sizeof (keyName);
          RegEnumKey (k, i, keyName, keyLen);
          if pathName = '' then
            DoWalk (keyName)
          else
            DoWalk (pathName + '\' + keyName)
        end
      end
    finally
      RegCloseKey (k);
    end
//    else
//      if err <> 161 then
//        raise EExRegistryException.Create (err, 'Unable to open key')
  end;
 
begin
  bufSize := 65536;
  GetMem (buffer, bufSize);
 
  try
    if Assigned (walkProc) then
      DoWalk (CurrentPath);
  finally
    FreeMem (buffer)
  end
end;
 
procedure TExRegistry.WriteStrings(const valueName: string;
  strings: TStrings);
var
  p, buffer : PChar;
  i : Integer;
  size : DWORD;
begin
  size := 0;
  for i := 0 to strings.Count - 1 do
    Inc (size, Length (strings [i]) + 1);
  Inc (size);
  GetMem (buffer, size);
  try
    p := buffer;
    for i := 0 to strings.count - 1 do
    begin
      lstrcpy (p, PChar (strings [i]));
      Inc (p, lstrlen (p) + 1)
    end;
    p^ := #0;
    SetLastError (RegSetValueEx (CurrentKey, PChar (valueName), 0, REG_MULTI_SZ, buffer, size));
    if GetLastError <> ERROR_SUCCESS then
      raise EExRegistryException.CreateLastError ('Unable to write MULTI_SZ value');
  finally
    FreeMem (buffer)
  end
end;
 
procedure TExRegistry.WriteTypedBinaryData(const valueName: string;
  tp: Integer; var data; size: Integer);
begin
  if RegSetValueEx (CurrentKey, PChar(valueName), 0, tp, @data, size) <> ERROR_SUCCESS then
    raise ERegistryException.CreateFmt('Unable to set registry data for %s', [valueName]);
end;
 
{ EExRegistryException }
 
constructor EExRegistryException.Create(code: DWORD; const st: string);
begin
  fCode := code;
  inherited Create (GetError + ':' + st);
end;
 
constructor EExRegistryException.CreateLastError(const st: string);
begin
  fCode := GetLastError;
  inherited Create (GetError + ':' + st);
end;
 
function EExRegistryException.GetError: string;
var
  msg : string;
 
  function GetErrorMessage (code : Integer) : string;
  var
    hErrLib : THandle;
    msg : PChar;
    flags : Integer;
 
    function MAKELANGID (p, s : word) : Integer;
    begin
      result := (s shl 10) or p
    end;
 
  begin
    hErrLib := LoadLibraryEx ('netmsg.dll', 0, LOAD_LIBRARY_AS_DATAFILE);
 
    try
 
      flags := FORMAT_MESSAGE_ALLOCATE_BUFFER or
               FORMAT_MESSAGE_IGNORE_INSERTS or
               FORMAT_MESSAGE_FROM_SYSTEM;
 
      if hErrLib <> 0 then
        flags := flags or FORMAT_MESSAGE_FROM_HMODULE;
 
      if FormatMessage (flags, pointer (hErrLib), code,
                        MAKELANGID (LANG_NEUTRAL, SUBLANG_DEFAULT),
                        PChar (@msg), 0, Nil) <> 0 then
        try
          result := msg;
 
        finally
          LocalFree (Integer (msg));
        end
 
    finally
      if hErrLib <> 0 then
        FreeLibrary (hErrLib)
    end
  end;
 
begin
  msg := GetErrorMessage (fCode);
  if msg = '' then
    result := Format ('Error %d', [fCode])
  else
    result := Format ('Error %d : %s', [fCode, msg])
end;
 
{ TSearchNode }
 
constructor TSearchNode.Create (ARegRoot : HKEY; const APath : string);
begin
  fRegRoot := ARegRoot;
  fValueIDX := -1;
  fKeyIdx := -1;
  fPath := APath
end;
 
destructor TSearchNode.Destroy;
begin
  fValueNames.Free;
  fKeyNames.Free;
  inherited Destroy
end;
 
procedure TSearchNode.LoadKeyNames;
var
  r : TExRegistry;
  i : Integer;
begin
  if not Assigned (fKeyNames) then
  begin
    fKeyNames := TStringList.Create;
    r := TExRegistry.Create;
    try
      r.RootKey := fRegRoot;
      r.OpenKey (fPath, False);
      r.GetKeyNames (fKeyNames);
    finally
      r.Free
    end;
    
    for i := 0 to fKeyNames.Count - 1 do
      fKeyNames [i] := UpperCase (fKeyNames [i]);
  end
end;
 
procedure TSearchNode.LoadValueNames;
var
  r : TExRegistry;
  i : Integer;
begin
  if not Assigned (fValueNames) then
  begin
    fValueNames := TStringList.Create;
    r := TExRegistry.Create;
    try
      r.RootKey := fRegRoot;
      r.OpenKey (fPath, False);
      r.GetValueNames (fValueNames);
    finally
      r.Free
    end;
 
    for i := 0 to fValueNames.Count - 1 do
      fValueNames [i] := UpperCase (fValueNames [i]);
  end
end;
 
end.
Attachments:
 
ExRegistry.png (83 KB) (File Type Details) 
Screenshot of the compiler error in Delphi
Screenshot of the compiler error in Delphi
 
[+][-]09/23/09 03:26 AM, ID: 25401435Accepted Solution

View this solution now by starting your 30-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

About this solution

Zones: Delphi Programming, Delphi Curiosities, Delphi IDE
Tags: Delphi 2010, Delphi 2009, compile, error
Sign Up Now!
Solution Provided By: ChristianWimmer
Participating Experts: 1
Solution Grade: A
 
 
Loading Advertisement...
20091111-EE-VQP-89 - Hierarchy / EE_QW_3_20080625