home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 1995 May / pcw-0595.bin / demos / databeck / wsounds / setup.dir / wswsrc.exe / DATAOBJ.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-02  |  31KB  |  1,037 lines
  1. { Unit Dataobj - for reading WAV file information }
  2.  
  3. Unit Dataobj;
  4.  
  5. Interface
  6.  
  7. Uses WObjects, WinDos, Wincrt, WinTypes, WinProcs, Strings, MMSystem, BWCC,
  8.      WaveUtil, StrTool;
  9.  
  10. TYPE
  11.    DirStr = Array[0..128] of Char;
  12.    DirStrP2 = Array[0..130] of Char;
  13.    WAVEDataType = RECORD
  14.       FileName      : ARRAY[0..12] OF Char;  { WAV file name }
  15.       PathName      : DirStr;                { Search path   }
  16.       CreationDate  : LongInt;               { File date     }
  17.       FileSize      : LongInt;               { File size     }
  18.       FileComment   : ARRAY[0..63] OF CHAR;  { WAV comments  }
  19.       DiskDrive     : Char;                  { Drive letter  }
  20.       DiskLabel     : ARRAY[0..12] OF CHAR;  { LW label      }
  21.       SampRate      : WORD;
  22.       Channels      : BYTE;
  23.       Save2Wave     : BYTE; {Flag, whether WAV file should be stored }
  24.                 {0 = No, 1 = Yes, 2 = Yes, but not successful yet }
  25.       END;
  26.  
  27.    WAVECriteria = RECORD
  28.       WName : ARRAY[0..12] OF Char;  { WAV file name }
  29.       WLabl : Array[0..12] OF CHAR;
  30.       WPath : DirStr;
  31.       WDat  : Byte;
  32.       WDay  : Array[0..2] OF Char;
  33.       WMon  : Array[0..2] OF Char;
  34.       WYear : Array[0..4] OF Char;
  35.       WCon0 : Byte;
  36.       WBase : ARRAY[0..63] OF CHAR;  { WAV comments  }
  37.       WCon1 : Byte;
  38.       WLim1 : ARRAY[0..63] OF CHAR;  { WAV comments  }
  39.       WCon2 : Byte;
  40.       WLim2 : ARRAY[0..63] OF CHAR;  { WAV comments  }
  41.       END;
  42.  
  43.    PWaveData = ^TWaveData;
  44.    TWaveData = OBJECT(TObject)
  45.       WD : WAVEDataType;                         { A record containing all data record values    }
  46.       CONSTRUCTOR Init(WData : WAVEDataType);    { Initializes an object instance                }
  47.       CONSTRUCTOR Load(VAR S : TStream);         { Method for loading instance                   }
  48.       PROCEDURE   Store(VAR S : TStream);        { Method for saving instance                    }
  49.       Procedure GetData(VAR WDL : WaveDataType); { Method for reading data                       }
  50.       Procedure Write; virtual;                  { Method for displaying instance                }
  51.       DESTRUCTOR Done; virtual;                  { Removes instance from memory                  }
  52.       END;
  53.  
  54.    PWaveCollection = ^TWaveCollection;
  55.    TWaveCollection = OBJECT(TSortedCollection)
  56.       function Compare(Key1, Key2: Pointer): Integer; virtual; { Method for comparing two instances }
  57.       end;
  58.  
  59. CONST
  60.    RWaveData : TStreamRec = (                               { Registration of type TWaveData }
  61.           ObjType : 1000;
  62.           VMTLink : Ofs(TypeOf(TWaveData)^);
  63.           Load    : @TWaveData.Load;
  64.           Store   : @TWaveData.Store
  65.           );
  66.  
  67.    RWaveColl : TStreamRec = (                               { Registration of type TWaveCollection }
  68.           ObjType : 1001;
  69.           VMTLink : Ofs(TypeOf(TWaveCollection)^);
  70.           Load    : @TWaveCollection.Load;
  71.           Store   : @TWaveCollection.Store
  72.           );
  73.  
  74.    RPlayColl : TStreamRec = (                               { Registration of type TWaveCollection }
  75.           ObjType : 1002;
  76.           VMTLink : Ofs(TypeOf(TCollection)^);
  77.           Load    : @TCollection.Load;
  78.           Store   : @TCollection.Store
  79.           );
  80.  
  81.    WildCard   = '*.*'; { Wildcard for all files }
  82.    ChooseWild = 'WAV'; { Wildcard for WAV files }
  83.  
  84.    
  85.    C2W_DontSave = 0; {Flags for comments in WAV files}
  86.    C2W_IsSaved  = 1;
  87.    C2W_Save     = 3;
  88.  
  89.  
  90. PROCEDURE WD_RegisterStreamTypes;
  91. PROCEDURE WD_ListAll(Data : PCollection);
  92. PROCEDURE WD_InsertAll(Data : PCollection; List : PListBox);
  93. PROCEDURE WD_CopyAll(DataSource, DataDest : PCollection);
  94. PROCEDURE WD_KillDoubles(VAR GetBack:Integer);
  95. PROCEDURE WD_SearchAll(HW : HWnd;DataSource, DataDest : PCollection; Criteria : WaveCriteria; VAR CurrCount : Integer);
  96. FUNCTION  WD_Search_NextOne(HW : HWnd;Num : Integer; Item : PWaveData; CRW : WaveCriteria) : Integer;
  97. FUNCTION WD_SearchNext(HW:HWnd;Num : Integer; Item : PWaveData; CRW : WaveCriteria) : Integer;
  98. PROCEDURE WD_TMP2DAT;
  99. Procedure WD_Scan4WorkDir;
  100. FUNCTION WD_NewShortPath(VAR RPath : DirStr; APath : DirStrP2; MaxLen : Integer) : PChar;
  101. Function  Exists(FileName : PChar):Boolean;
  102. Procedure WD_NewShortHelp(APath : DirStrP2; MaxLen : Integer);
  103.  
  104. VAR
  105.    WAVECollect    : PWaveCollection; { Variable for Database instance        }
  106.    WaveSelectColl : PWaveCollection; { Variable for Select data instance    }
  107.    WaveTakeColl   : PWaveCollection; { Variable for final selected files }
  108.    WavePlayColl   : PCollection;     { Variable for Play data instance }
  109.    WaveDummyColl  : PWAVECollection;
  110.    WaveStream     : PBufStream;      { Variable for file stream           }
  111.    WAVEDummy      : WaveDataType;    { Dummy variable for filling data records }
  112.    WaveDCrit      : WaveCriteria;
  113.    RootPath       : Array[0..fsPathName] of Char;
  114.    RootDir        : Array[0..fsDirectory] of Char;
  115.    RootFile       : Array[0..fsFileName] of Char;
  116.    RootExt        : Array[0..fsExtension] of Char;
  117.    WF_TMP         : Array[0..145] of Char;
  118.    WF_DAT         : Array[0..145] of Char;
  119.    WF_CAS         : Array[0..145] of Char;
  120.    WF_EVE         : Array[0..145] of Char;
  121.    DBChanged      : Boolean; { Flag, whether database has been changed }
  122.  
  123.    ShortHelp      : DirStrP2;
  124.    ShortMain      : DirStrP2;
  125.  
  126. IMPLEMENTATION
  127.  
  128. VAR
  129.    GlobDum : DirStr;
  130.  
  131. {---------------------------------------------------------------------------------------------}
  132.  
  133. { TWaveData }
  134. CONSTRUCTOR TWaveData.Init(WData : WAVEDataType);
  135. BEGIN
  136.    WD := WData;
  137.    END;
  138.  
  139. CONSTRUCTOR TWaveData.Load(VAR S : TStream);
  140. BEGIN
  141.    S.Read(WD,SizeOf(WD));
  142.    END;
  143.  
  144. PROCEDURE TWaveData.Store(VAR S : TStream);
  145. BEGIN
  146.    S.Write(WD,SizeOf(WD));
  147.    END;
  148.  
  149. PROCEDURE TWaveData.GetData(VAR WDL : WaveDataType);
  150. BEGIN
  151.    WDL := WD;
  152.    END;
  153.  
  154. PROCEDURE TWaveData.Write;
  155. BEGIN
  156.    WriteLn('--------------------------------------------------');
  157.    WriteLn(' Name : ',WD.FileName,', Size : ',WD.FileSize);
  158.    WriteLn(' Disk : ', WD.DiskLabel,' -> ',WD.DiskDrive, ':',WD.PathName);
  159.    WriteLn(' Comm : ', WD.FileComment);
  160.    END;
  161.  
  162. DESTRUCTOR TWaveData.Done;
  163. BEGIN
  164.    END;
  165.  
  166. {----------------------------------------------------------------------------------------------}
  167. function TWaveCollection.Compare(Key1, Key2: Pointer): Integer;
  168. { Compare criteria is file name }
  169. VAR
  170.   PWD1, PWD2 : WaveDataType;
  171.   Check : Integer;
  172. begin
  173.   PWaveData(Key1)^.GetData(PWD1);
  174.   PWaveData(Key2)^.GetData(PWD2);
  175.  
  176.   IF (StrPas(pwd1.FileName) < StrPas(pwd2.FileName)) THEN Check := -1 Else
  177.   IF (StrPas(pwd1.FileName) > StrPas(pwd2.FileName)) THEN Check :=  1 Else
  178.                               Check :=  0;
  179.   IF (Check = 0) THEN BEGIN
  180.      IF (StrPas(pwd1.PathName) < StrPas(pwd2.PathName)) THEN Check := -1 Else
  181.      IF (StrPas(pwd1.PathName) > StrPas(pwd2.PathName)) THEN Check :=  1 Else
  182.                                  Check :=  0;
  183.      END;
  184.  
  185.   IF (Check = 0) THEN BEGIN
  186.      IF (StrPas(pwd1.DiskLabel) < StrPas(pwd2.DiskLabel)) THEN Check := -1 Else
  187.      IF (StrPas(pwd1.DiskLabel) > StrPas(pwd2.DiskLabel)) THEN Check :=  1 Else
  188.                                    Check :=  0;
  189.      END;
  190.  
  191.   IF (Check = 0) THEN BEGIN
  192.      IF ((pwd1.DiskDrive) < (pwd2.DiskDrive)) THEN Check := -1 Else
  193.      IF ((pwd1.DiskDrive) > (pwd2.DiskDrive)) THEN Check :=  1 Else
  194.                            Check :=  0;
  195.      END;
  196.  
  197.   IF (Check = 0) THEN BEGIN
  198.      IF ((pwd1.FileSize) < (pwd2.FileSize)) THEN Check := -1 Else
  199.      IF ((pwd1.FileSize) > (pwd2.FileSize)) THEN Check :=  1 Else
  200.                          Check :=  0;
  201.      END;
  202.  
  203.   IF (Check = 0) THEN BEGIN
  204.      IF ((pwd1.CreationDate) < (pwd2.CreationDate)) THEN Check := -1 Else
  205.      IF ((pwd1.CreationDate) > (pwd2.CreationDate)) THEN Check :=  1 Else
  206.                              Check :=  0;
  207.      END;
  208.  
  209.   Compare := Check;
  210.   {Compare := StrComp(PWD1.FileName,PWD1.FileName);}
  211. end;
  212. {----------------------------------------------------------------------------------------------}
  213. PROCEDURE WD_RegisterStreamTypes;
  214. {
  215.  *** Input     : None
  216.  *** Output    : None
  217.  *** Remarks   : Registers data stream types
  218. }
  219. BEGIN
  220.    RegisterType (RWaveData);
  221.    RegisterType (RWaveColl);
  222.    RegisterType (RPlayColl);
  223.    END;
  224. {----------------------------------------------------------------------------------------------}
  225. PROCEDURE WD_ListAll(Data : PCollection);
  226. {
  227.  *** Input     : Pointer to collection
  228.  *** Output    : None
  229.  *** Remarks   : Displays all collection elements on the screen
  230. }
  231.  
  232.    PROCEDURE List_One(Item : PWaveData); FAR;
  233.    BEGIN
  234.       Item^.Write;
  235.       END;
  236. BEGIN
  237.    Data^.ForEach(@List_One);
  238.    END;
  239. {----------------------------------------------------------------------------------------------}
  240. PROCEDURE WD_InsertAll(Data : PCollection; List : PListBox);
  241. {
  242.  *** Input     : Pointer to collection
  243.          Pointer to list box
  244.  *** Output    : None
  245.  *** Remarks   : Displays all collection elements in a list box
  246. }
  247.  
  248.    PROCEDURE Insert_One(Item : PWaveData); FAR;
  249.    BEGIN
  250.       {WriteLn('Tutti Frutti');}
  251.       List^.AddString(Item^.WD.FileName);
  252.       END;
  253. BEGIN
  254.    Data^.ForEach(@Insert_One);
  255.    {WriteLn('I think, therefore I am broke');}
  256.    END;
  257. {----------------------------------------------------------------------------------------------}
  258. PROCEDURE WD_CopyAll(DataSource, DataDest : PCollection);
  259. {
  260.  *** Input     : Pointer to source collection
  261.          Pointer to dest collection
  262.  *** Output    : None
  263.  *** Remarks   : Copies all collection elements
  264. }
  265.  
  266.    PROCEDURE Copy_One(Item : PWaveData); FAR;
  267.    BEGIN
  268.       DataDest^.Insert(Item);
  269.       END;
  270. BEGIN
  271.    DataSource^.ForEach(@Copy_One);
  272.    END;
  273.  
  274. {----------------------------------------------------------------------------------------------}
  275. {----------------------------------------------------------------------------------------------}
  276.  
  277.  
  278. PROCEDURE WD_KillDoubles(VAR GetBack:Integer);
  279. {
  280.  *** Input     : Pointer to source collection
  281.          Pointer to dest collection
  282.  *** Output    : None
  283.  *** Remarks   : Copies all collection elements
  284. }
  285. VAR
  286.   Idx       : Integer;
  287.  
  288.    PROCEDURE Count_One(Item : PWaveData); FAR;
  289.    BEGIN
  290.       IF (WaveCollect^.Search(Item,Idx) = True) THEN BEGIN
  291.      END
  292.       ELSE BEGIN
  293.      WaveDummyColl^.Insert(Item);
  294.      Inc(GetBack,1);
  295.      END;
  296.       END;
  297. BEGIN
  298.    GetBack := 0;
  299.    WaveSelectColl^.ForEach(@Count_One);
  300.    WaveSelectColl^.DeleteAll;
  301.    WD_CopyAll(WaveDummyColl, WaveSelectColl);
  302.    WaveDummyColl^.DeleteAll;
  303.    END;
  304. (*
  305. PROCEDURE WD_CountAll(VAR DataSource, DataDest : PWaveCollection; GetBack : Integer);
  306. {
  307.  *** Input     : Pointer to source collection
  308.          Pointer to dest collection
  309.  *** Output    : None
  310.  *** Remarks   : Copies all collection elements
  311. }
  312. VAR
  313.   Idx       : Integer;
  314.  
  315.    PROCEDURE Count_One(Item : PWaveData); FAR;
  316.    BEGIN
  317.       Write('Here am I');
  318.       IF (DataDest^.Search(Item,Idx) = True) THEN BEGIN
  319.      Write(', OK, found... ');
  320.      END
  321.       ELSE BEGIN
  322.      WaveDummyColl^.Insert(Item);
  323.      Inc(GetBack,1);
  324.      WriteLn(GetBack);
  325.      END;
  326.       END;
  327. BEGIN
  328.    GetBack := 0;
  329.    DataSource^.ForEach(@Count_One);
  330.    DataSource^.DeleteAll;
  331.    WD_CopyAll(WaveDummyColl, DataSource);
  332.    WaveDummyColl^.DeleteAll;
  333.    END;
  334. *)
  335. {----------------------------------------------------------------------------------------------}
  336.  
  337. PROCEDURE WD_SearchAll(HW : HWnd;DataSource, DataDest : PCollection; Criteria : WaveCriteria; VAR CurrCount : Integer);
  338. {
  339.  *** Input     : Pointer to source collection
  340.          Pointer to dest collection
  341.  *** Output    : None
  342.  *** Remarks   : Copies all collection elements
  343. }
  344. VAR
  345.   StartCount : Integer;
  346.  
  347. FUNCTION WD_ScanItem(It : PWaveData; Cr : WaveCriteria) : Boolean;
  348. VAR
  349.    WD : WaveDataType;
  350.    Test1,
  351.    Test11,
  352.    Test15,
  353.    Test2,
  354.    Test3,
  355.    Test4,
  356.    TestDat  : Boolean;
  357.    DateTime : TDateTime;
  358.    DayDum   : Array[0..2] OF Char;
  359.    MonDum   : Array[0..2] OF Char;
  360.    YearDum  : Array[0..4] OF Char;
  361.    Cyear,
  362.    CMon,
  363.    CDay,
  364.    i        : Integer;
  365.    DPath : DirStr;
  366.    HelpPChar : Array[0..1] of Char;
  367. BEGIN
  368.    It^.GetData(WD);
  369.  
  370.  
  371.    
  372. { Search for entered file name }
  373.    Test1 := (STRCheckSub(Cr.WName, WD.FileName, 0));
  374.    IF Not(Test1) THEN BEGIN
  375.       WD_ScanItem := False;
  376.       Exit;
  377.       END;
  378.  
  379. {
  380.    WriteLn('-------------------------------------------------------');
  381.    WriteLn(' Crit : ',Cr.WLabl);
  382.    WriteLn(' Labl : ',WD.DiskLabel);
  383. }
  384.    Test11 := (STRCheckSub(Cr.WLabl, WD.DiskLabel, 0));
  385.    IF Not(Test11) THEN BEGIN
  386.       WD_ScanItem := False;
  387.       Exit;
  388.       END;
  389.  
  390. { Searched only on one drive??? }
  391.    IF (StrLen(Cr.WPath) = 3) THEN
  392.       IF ((Cr.WPath[1] = ':') AND (WD.DiskDrive <> Cr.WPath[0])) THEN BEGIN
  393.      WD_ScanItem := False;
  394.      Exit;
  395.      END;
  396.  
  397. { More than three characters entered??? }
  398. { Then add a path name }
  399.    IF (StrLen(Cr.WPath) >= 3) THEN BEGIN
  400.       IF ((Cr.WPath[1] = ':') AND (WD.DiskDrive <> Cr.WPath[0])) THEN BEGIN
  401.      WD_ScanItem := False;
  402.      Exit;
  403.      END;
  404. { If you entered a drive, then truncate this }
  405.       IF ((Cr.WPath[1] = ':')) THEN BEGIN
  406.      DPath[0] := #0;
  407.      For i := 2 to Strlen(Cr.WPath) DO BEGIN
  408.         HelpPChar[0] := Cr.WPath[i];
  409.         HelpPChar[1] := #0;
  410.         StrCat(DPath, HelpPChar);
  411.         END;
  412.      Test1 := (STRCheckSub(DPath, WD.PathName, 0));
  413.      END
  414. { No valid drive entered }
  415. { Search for entire entry }
  416.       ELSE Test1 := (STRCheckSub(Cr.WPath, WD.PathName, 0));
  417.  
  418.       IF Not(Test1) THEN BEGIN
  419.      WD_ScanItem := False;
  420.      Exit;
  421.      END;
  422.       END;
  423.  
  424.    IF ((StrLen(Cr.WDay) <> 0) OR (StrLen(Cr.WMon) <> 0) OR (StrLen(Cr.WYear) <> 0)) THEN BEGIN
  425.  
  426.       TestDat := False;
  427.  
  428.       Unpacktime(WD.CreationDate, DateTime);
  429.  
  430.       Str(DateTime.Day:2  , DayDum);
  431.       For i := 0 to StrLen(DayDum) DO BEGIN
  432.      IF DayDum[i] = ' ' Then DayDum[i] := '0';
  433.      END;
  434.       Str(DateTime.Month:2, MonDum);
  435.       For i := 0 to StrLen(MonDum) DO BEGIN
  436.      IF MonDum[i] = ' ' Then MonDum[i] := '0';
  437.      END;
  438.       Str(DateTime.Year:4 , YearDum);
  439.       For i := 0 to StrLen(Yeardum) DO BEGIN
  440.      IF YearDum[i] = ' ' Then Yeardum[i] := '0';
  441.      END;
  442.  
  443.       {
  444.       Writeln('--------------------------');
  445.       WriteLn('Year : ',Cr.WYear);
  446.       WriteLn('Day  : ',Cr.WDay);
  447.       WriteLn('Month: ',Cr.WMon);
  448.       }
  449.       {
  450.       IF StrComp(Cr.WMon,'00') = 0 THEN StrCopy(Cr.WMon,MonDum);
  451.       IF StrComp(Cr.WDay,'00') = 0 THEN StrCopy(Cr.WDay,DayDum);
  452.       IF StrComp(Cr.WYear,'0000') = 0 THEN StrCopy(Cr.WYear,YearDum);
  453.       }
  454.       IF StrComp(Cr.WDay,'') = 0 THEN BEGIN
  455.      StrCopy(Cr.WDay,DayDum);
  456.      Cr.WDat := 1;
  457.      END;
  458.       IF StrComp(Cr.WMon,'') = 0 THEN BEGIN
  459.      StrCopy(Cr.WMon,MonDum);
  460.      Cr.WDat := 1;
  461.      END;
  462.       IF StrComp(Cr.WYear,'') = 0 THEN BEGIN
  463.      StrCopy(Cr.WYear,YearDum);
  464.      Cr.WDat := 1;
  465.      END;
  466.  
  467.       {
  468.       WriteLn('Year : ',Cr.WYear);
  469.       WriteLn('Month: ',Cr.WMon);
  470.       WriteLn('Day  : ',Cr.WDay);
  471.       }
  472.  
  473.       CYear := StrComp(YearDum, Cr.WYear);
  474.       CMon  := StrComp(MonDum, Cr.WMon);
  475.       CDay  := StrComp(DayDum, Cr.WDay);
  476.  
  477.       Case Cr.WDat OF
  478.      1 : BEGIN {Exact}
  479.            IF (CYear = 0) THEN
  480.           IF (CMon =0) THEN
  481.              IF (CDay =0) THEN TestDat := True;
  482.            END;
  483.       
  484.      3 : BEGIN {Newer}
  485.            IF (CYear < 0) Then TestDat := TRUE
  486.            ELSE BEGIN
  487.               IF (CYear = 0) THEN BEGIN
  488.                        IF (CMon < 0) THEN TestDat := True
  489.                              ELSE BEGIN
  490.                                 IF (CMon = 0) THEN BEGIN
  491.                                             IF (CDay < 0) THEN TestDat := True;
  492.                                             END
  493.                                           ELSE BEGIN
  494.                                             TestDat := False; { CMon > 0 }
  495.                                             END;
  496.                                 END
  497.                        END
  498.                      ELSE BEGIN
  499.                        TestDat := False; { CYear > 0 }
  500.                        END;
  501.               END;
  502.          END;
  503.      2 : BEGIN {Newer}
  504.            IF (CYear > 0) Then TestDat := TRUE
  505.            ELSE BEGIN
  506.               IF (CYear = 0) THEN BEGIN
  507.                        IF (CMon > 0) THEN TestDat := True
  508.                              ELSE BEGIN
  509.                                 IF (CMon = 0) THEN BEGIN
  510.                                             IF (CDay > 0) THEN TestDat := True;
  511.                                             END
  512.                                           ELSE BEGIN
  513.                                             TestDat := False; { CMon > 0 }
  514.                                             END;
  515.                                 END
  516.                        END
  517.                      ELSE BEGIN
  518.                        TestDat := False; { CYear > 0 }
  519.                        END;
  520.               END;
  521.          END;
  522.      END;
  523. {
  524.       IF TestDat = TRUE THEN BEGIN
  525.      WriteLn('---------------------------------------------------------');
  526.      WriteLn('Criteria  : ',Cr.WDat);
  527.      WriteLn('Day : ',DayDum,' - searched: ',Cr.WDay,' Compare to: ',CDay);
  528.      WriteLn('Mon : ',MonDum,' - searched: ',Cr.WMon,' Compare to: ',CMon);
  529.      WriteLn('Yr  : ',YearDum,' - searched: ',Cr.WYear,' Compare to: ',CYear);
  530.      END;
  531. }
  532.      END
  533.     ELSE TestDat := True;
  534.  
  535.    IF (TestDat = False) THEN BEGIN
  536.       WD_ScanItem := False;
  537.       Exit;
  538.       END;
  539.  
  540.    Test15 := (STRCheckSub(Cr.WBase, WD.FileComment, Cr.WCon0));
  541.    Test3 := (STRCheckSub(Cr.WLim1, WD.FileComment, Cr.WCon1));
  542.    Test4 := (STRCheckSub(Cr.WLim2, WD.FileComment, Cr.WCon2));
  543.  
  544.    
  545.    IF ((Cr.WCon0 = 0) OR (Cr.WCon0 = 2)) THEN Test2 := (TRUE AND Test15)
  546.    ELSE Test2 := True;
  547.    
  548.    IF (Cr.Wcon1 = 1) THEN BEGIN
  549.       IF (Cr.WCon2 = 1) THEN Test1 := (Test2 OR Test3) OR Test4  {AND OR OR      }
  550.             ELSE Test1 := (Test2 OR Test3) AND Test4 {AND OR AND/NOT }
  551.       END
  552.    ELSE BEGIN
  553.       IF (Cr.WCon2 = 1) THEN Test1 := (Test2 AND Test3) OR Test4   { AND AND/NOT OR      }
  554.             ELSE Test1 := (Test2 AND Test3) AND Test4; { AND AND/NOT AND/NOT }
  555.       END;
  556.  
  557.    IF Not(Test1) THEN BEGIN
  558.       WD_ScanItem := False;
  559.       Exit;
  560.       END;
  561.    WD_ScanItem := True;
  562.    END;
  563.  
  564.    PROCEDURE Search_One(Item : PWaveData); FAR;
  565.    VAR
  566.      PString : String[7];
  567.      CString : Array[0..7] OF Char;
  568.    BEGIN
  569.       SetDlgItemText(HW, 1300, Item^.WD.FileName);
  570.       SetDlgItemText(HW, 1301, Item^.WD.FileComment);
  571.       IF (WD_ScanItem(Item,Criteria) = TRUE) THEN BEGIN
  572.      DataDest^.Insert(Item);
  573.      Inc(CurrCount);
  574.      Str(CurrCount:5,PString);
  575.      StrPCopy(CString,PString);
  576.      SetDlgItemText(HW, 1303, CString);
  577.      END
  578.      ELSE BEGIN
  579.        END;
  580.       END;
  581. BEGIN
  582.    StartCount := DataDest^.Count;
  583.    CurrCount := 0;
  584.    DataSource^.ForEach(@Search_One);
  585.    END;
  586.  
  587. {----------------------------------------------------------------------------------------------}
  588.  
  589. FUNCTION WD_ScanOneItem(It : PWaveData; Cr : WaveCriteria) : Boolean;
  590. VAR
  591.    WD : WaveDataType;
  592.    Test1,
  593.    Test11,
  594.    Test15,
  595.    Test2,
  596.    Test3,
  597.    Test4,
  598.    TestDat  : Boolean;
  599.    DateTime : TDateTime;
  600.    DayDum   : Array[0..2] OF Char;
  601.    MonDum   : Array[0..2] OF Char;
  602.    YearDum  : Array[0..4] OF Char;
  603.    Cyear,
  604.    CMon,
  605.    CDay,
  606.    i        : Integer;
  607.    DPath : DirStr;
  608.    HelpPChar : Array[0..1] of Char;
  609. BEGIN
  610.    It^.GetData(WD);
  611.  
  612. { Search for file name }
  613.    Test1 := (STRCheckSub(Cr.WName, WD.FileName, 0));
  614.    IF Not(Test1) THEN BEGIN
  615.       WD_ScanOneItem := False;
  616.       Exit;
  617.       END;
  618.  
  619. {
  620.    WriteLn('-------------------------------------------------------');
  621.    WriteLn(' Crit : ',Cr.WLabl);
  622.    WriteLn(' Labl : ',WD.DiskLabel);
  623. }
  624.    Test11 := (STRCheckSub(Cr.WLabl, WD.DiskLabel, 0));
  625.    IF Not(Test11) THEN BEGIN
  626.       WD_ScanOneItem := False;
  627.       Exit;
  628.       END;
  629.  
  630. { Search only one drive? }
  631.    IF (StrLen(Cr.WPath) = 3) THEN
  632.       IF ((Cr.WPath[1] = ':') AND (WD.DiskDrive <> Cr.WPath[0])) THEN BEGIN
  633.      WD_ScanOneItem := False;
  634.      Exit;
  635.      END;
  636.  
  637. { More than three characters entered? }
  638. { Add a path name }
  639.    IF (StrLen(Cr.WPath) >= 3) THEN BEGIN
  640.       IF ((Cr.WPath[1] = ':') AND (WD.DiskDrive <> Cr.WPath[0])) THEN BEGIN
  641.      WD_ScanOneItem := False;
  642.      Exit;
  643.      END;
  644. { If drive is entered, then truncate }
  645.       IF ((Cr.WPath[1] = ':')) THEN BEGIN
  646.      DPath[0] := #0;
  647.      For i := 2 to Strlen(Cr.WPath) DO BEGIN
  648.         HelpPChar[0] := Cr.WPath[i];
  649.         HelpPChar[1] := #0;
  650.         StrCat(DPath, HelpPChar);
  651.         END;
  652.      Test1 := (STRCheckSub(DPath, WD.PathName, 0));
  653.      END
  654. { No valid drive entered }
  655. { Search for entire entry }
  656.       ELSE Test1 := (STRCheckSub(Cr.WPath, WD.PathName, 0));
  657.  
  658.       IF Not(Test1) THEN BEGIN
  659.      WD_ScanOneItem := False;
  660.      Exit;
  661.      END;
  662.       END;
  663.  
  664.    IF ((StrLen(Cr.WDay) <> 0) OR (StrLen(Cr.WMon) <> 0) OR (StrLen(Cr.WYear) <> 0)) THEN BEGIN
  665.  
  666.       TestDat := False;
  667.  
  668.       Unpacktime(WD.CreationDate, DateTime);
  669.  
  670.       Str(DateTime.Day:2  , DayDum);
  671.       For i := 0 to StrLen(DayDum) DO BEGIN
  672.      IF DayDum[i] = ' ' Then DayDum[i] := '0';
  673.      END;
  674.       Str(DateTime.Month:2, MonDum);
  675.       For i := 0 to StrLen(MonDum) DO BEGIN
  676.      IF MonDum[i] = ' ' Then MonDum[i] := '0';
  677.      END;
  678.       Str(DateTime.Year:4 , YearDum);
  679.       For i := 0 to StrLen(Yeardum) DO BEGIN
  680.      IF YearDum[i] = ' ' Then Yeardum[i] := '0';
  681.      END;
  682.  
  683.       IF StrComp(Cr.WDay,'') = 0 THEN BEGIN
  684.      StrCopy(Cr.WDay,DayDum);
  685.      Cr.WDat := 1;
  686.      END;
  687.       IF StrComp(Cr.WMon,'') = 0 THEN BEGIN
  688.      StrCopy(Cr.WMon,MonDum);
  689.      Cr.WDat := 1;
  690.      END;
  691.       IF StrComp(Cr.WYear,'') = 0 THEN BEGIN
  692.      StrCopy(Cr.WYear,YearDum);
  693.      Cr.WDat := 1;
  694.      END;
  695.  
  696.  
  697.       CYear := StrComp(YearDum, Cr.WYear);
  698.       CMon  := StrComp(MonDum, Cr.WMon);
  699.       CDay  := StrComp(DayDum, Cr.WDay);
  700.  
  701.       Case Cr.WDat OF
  702.      1 : BEGIN {Exact}
  703.            IF (CYear = 0) THEN
  704.           IF (CMon = 0) THEN
  705.              IF (CDay = 0) THEN TestDat := True;
  706.            END;
  707.       
  708.      3 : BEGIN {Newer}
  709.            IF (CYear < 0) Then TestDat := TRUE
  710.            ELSE BEGIN
  711.               IF (CYear = 0) THEN BEGIN
  712.                        IF (CMon < 0) THEN TestDat := True
  713.                              ELSE BEGIN
  714.                                 IF (CMon = 0) THEN BEGIN
  715.                                             IF (CDay < 0) THEN TestDat := True;
  716.                                             END
  717.                                           ELSE BEGIN
  718.                                             TestDat := False; { CMon > 0 }
  719.                                             END;
  720.                                 END
  721.                        END
  722.                      ELSE BEGIN
  723.                        TestDat := False; { CYear > 0 }
  724.                        END;
  725.               END;
  726.          END;
  727.      2 : BEGIN {Newer}
  728.            IF (CYear > 0) Then TestDat := TRUE
  729.            ELSE BEGIN
  730.               IF (CYear = 0) THEN BEGIN
  731.                        IF (CMon > 0) THEN TestDat := True
  732.                              ELSE BEGIN
  733.                                 IF (CMon = 0) THEN BEGIN
  734.                                             IF (CDay > 0) THEN TestDat := True;
  735.                                             END
  736.                                           ELSE BEGIN
  737.                                             TestDat := False; { CMon > 0 }
  738.                                             END;
  739.                                 END
  740.                        END
  741.                      ELSE BEGIN
  742.                        TestDat := False; { CYear > 0 }
  743.                        END;
  744.               END;
  745.          END;
  746.      END;
  747. {
  748.       IF TestDat = TRUE THEN BEGIN
  749.      WriteLn('---------------------------------------------------------');
  750.      WriteLn('Criteria  : ',Cr.WDat);
  751.      WriteLn('Mon : ',MonDum,' - searched: ',Cr.WMon,' Compare to: ',CMon);
  752.      WriteLn('Yr  : ',YearDum,' - searched: ',Cr.WYear,' Compare to: ',CYear);
  753.      WriteLn('Day : ',DayDum,' - searched: ',Cr.WDay,' Compare to: ',CDay);
  754.      END;
  755. }
  756.      END
  757.     ELSE TestDat := True;
  758.  
  759.    IF (TestDat = False) THEN BEGIN
  760.       WD_ScanOneItem := False;
  761.       Exit;
  762.       END;
  763.  
  764.    Test15 := (STRCheckSub(Cr.WBase, WD.FileComment, Cr.WCon0));
  765.    Test3 := (STRCheckSub(Cr.WLim1, WD.FileComment, Cr.WCon1));
  766.    Test4 := (STRCheckSub(Cr.WLim2, WD.FileComment, Cr.WCon2));
  767.  
  768. {
  769.    WriteLn(Cr.WLim2, ' -- ',WD.FileComment);
  770.    WriteLn(Test15,test3,test4);
  771. }
  772.    IF ((Cr.WCon0 = 0) OR (Cr.WCon0 = 2)) THEN Test2 := (TRUE AND Test15)
  773.    ELSE Test2 := True;
  774.    
  775.    IF (Cr.Wcon1 = 1) THEN BEGIN
  776.       IF (Cr.WCon2 = 1) THEN Test1 := (Test2 OR Test3) OR Test4  {AND OR OR      }
  777.             ELSE Test1 := (Test2 OR Test3) AND Test4 {AND OR AND/NOT }
  778.       END
  779.    ELSE BEGIN
  780.       IF (Cr.WCon2 = 1) THEN Test1 := (Test2 AND Test3) OR Test4   { AND AND/NOT OR      }
  781.             ELSE Test1 := (Test2 AND Test3) AND Test4; { AND AND/NOT AND/NOT }
  782.       END;
  783.  
  784.    IF Not(Test1) THEN BEGIN
  785.       WD_ScanOneItem := False;
  786.       Exit;
  787.       END;
  788.    WD_ScanOneItem := True;
  789.    END;
  790.  
  791.  
  792. FUNCTION WD_SearchNext(HW:HWnd;Num : Integer; Item : PWaveData; CRW : WaveCriteria) : Integer;
  793.    VAR
  794.      PString : String[7];
  795.      CString : Array[0..7] OF Char;
  796.    BEGIN
  797.       SetDlgItemText(HW, 1300, Item^.WD.FileName);
  798.       SetDlgItemText(HW, 1301, Item^.WD.FileComment);
  799.       IF (WD_ScanOneItem(Item,CRW) = TRUE) THEN BEGIN
  800.      WD_SearchNext := Num;
  801.      END
  802.      ELSE BEGIN
  803.        WD_SearchNext := -1;
  804.        END;
  805.       END;
  806.  
  807. FUNCTION WD_Search_NextOne(HW : HWnd;Num : Integer; Item : PWaveData; CRW : WaveCriteria) : Integer;
  808.    VAR
  809.      PString : String[7];
  810.      CString : Array[0..7] OF Char;
  811.    BEGIN
  812.       SetDlgItemText(HW, 1300, Item^.WD.FileName);
  813.       SetDlgItemText(HW, 1301, Item^.WD.FileComment);
  814.       IF (WD_ScanOneItem(Item,CRW) = TRUE) THEN BEGIN
  815.      WD_Search_NextOne := Num;
  816.      END
  817.      ELSE BEGIN
  818.        WD_Search_NextOne := -1;
  819.        END;
  820.       END;
  821.  
  822. {----------------------------------------------------------------------------------------------}
  823. procedure WD_InitAll;
  824. BEGIN
  825.    WaveCollect := New(PWaveCollection, Init(20,5));
  826.    WaveStream := New ( PBufStream);
  827.    Wavestream^.Init('WaveDeck.Dat',  stOpen, 512);
  828.    WriteLn('Read stream in collection');
  829.    WriteLn('Status : ',WaveStream^.Status);
  830.    IF (WaveStream^.Status = stOK) THEN WaveCollect := PWaveCollection(WaveStream^.Get)
  831.    ELSE
  832.    IF (WaveStream^.Status <> stOK) THEN BEGIN
  833.       WriteLn('!!!!!!!!!!!!!!!! No stream found !!!!!!!!!!!!!');
  834.       IF (WaveStream^.Status = stInitError) THEN BEGIN
  835.        Writeln('Creating new stream ');
  836.        WaveStream^.Reset;
  837.        Dispose(WaveStream,Done);
  838.        WaveStream := New ( PBufStream, Init('WaveDeck.Dat',  stCreate, 512));
  839.        END
  840.       ELSE BEGIN
  841.        MessageBox(0, 'Error loading stream.','Application Error', mb_Ok);
  842.        END;
  843.       END;
  844. END;
  845.  
  846. Function Exists(FileName : PChar):Boolean;
  847. VAR F : File;
  848. BEGIN
  849. {$I-}
  850.    Assign(F,FileName);
  851.    Reset(f);
  852.    Close(f);
  853. {$I+}
  854.    if IOResult = 0 then Exists := True else Exists := False;
  855.    END;
  856.  
  857. Procedure WD_TMP2DAT;
  858. VAR
  859.    F:File;
  860. BEGIN
  861.    if exists(WF_TMP) THEN BEGIN
  862.       IF exists(WF_DAT) THEN BEGIN
  863.      Assign(f,WF_DAT);
  864.      Erase(f);
  865.      Assign(f,WF_TMP);
  866.      Rename(f,WF_DAT);
  867.      END
  868.       ELSE BEGIN
  869.      Assign(f,WF_TMP);
  870.      Rename(f,WF_DAT);
  871.      END;
  872.       END;
  873.    END;
  874.  
  875. Procedure WD_Scan4WorkDir;
  876. BEGIN
  877. { Read basic directory for program bootup }
  878.     StrPCopy(RootPath,Paramstr(0));
  879.     filesplit(RootPath, RootDir, RootFile, RootExt);
  880. { Declare variable for TMP files }
  881.     StrCopy(WF_TMP, RootDir);
  882.     StrCat(WF_TMP,'WSW.TMP');
  883. { Declare variable for DAT file }
  884.     StrCopy(WF_DAT, RootDir);
  885.     StrCat(WF_DAT,'WSW.DAT');
  886. { Declare variable for CAS file }
  887.     StrCopy(WF_CAS, RootDir);
  888.     StrCat(WF_CAS,'WSWCAS.DAT');
  889. { Variable for Event file }
  890.     StrCopy(WF_EVE, RootDir);
  891.     StrCat(WF_EVE,'WSWEVENT.DAT');
  892.  
  893. {
  894.     WriteLn('WAV file  : ',WF_DAT);
  895.     WriteLn('WAV temp  : ',WF_TMP);
  896.     WriteLn('Root DIR  : ',RootDir);
  897. }
  898.     END;
  899.  
  900. FUNCTION WD_NewShortPath(VAR RPath : DirStr; APath : DirStrP2; MaxLen : Integer) : PChar;
  901. VAR
  902.    Count : Integer;
  903.    Slash1 : Integer;
  904.    Slash2 : Integer;
  905.    Slash3 : Integer;
  906.    Slash4 : Integer;
  907.    NPath : DirStr;
  908. {   RPath : DirStr;}
  909.    BPath : DirStr;
  910.    RLen : Integer;
  911. BEGIN
  912.    WriteLn('Apath:',APath);
  913.    WriteLn('Max  :',MaxLen);
  914.    IF StrLen(APath) < MaxLen THEN BEGIN
  915.       WD_NewShortPath := APath;
  916.       Exit;
  917.       END;
  918.    IF StrLen(APath) <=3 THEN BEGIN
  919.       WD_NewShortPath := APath;
  920.       Exit;
  921.       END;
  922.    Slash1 := -1;
  923.    Slash2 := -1;
  924.    Slash3 := -1;
  925.    Slash4 := -1;
  926.    {WriteLn('APath : ',APath);}
  927.    For Count := 0 to SizeOf(DirStr) DO RPath[Count] := #0;
  928.    WriteLn('Rpath:', RPath);
  929.    For Count := 0 to StrLen(APath) DO BEGIN
  930.       {
  931.       Write('Apath : ',APath[Count]);
  932.       WriteLn('--->', StrLen(APath),' :');
  933.       }
  934.       IF ((APath[Count] = '\') and (Slash1 = -1)) THEN Slash1 := Count;
  935.       IF ((APath[Count] = '\') and (Slash2 = -1) and (Slash1 <> -1)) THEN BEGIN
  936.      Slash2 := Count;
  937.      END;
  938.       end;
  939.    For Count := StrLen(APath)-1 Downto 0 DO BEGIN
  940.       {Writeln('Apath back: ',APath[Count]);}
  941.       IF ((APath[Count] = '\') and (Slash3 = -1)) THEN BEGIN
  942.      Slash3 := Count;
  943.      {Count := 0;}
  944.      END;
  945.       end;
  946.    StrLCopy(RPath,APath,Slash2);
  947.    StrCat(RPath,'...');
  948.    FOR Count := Slash3 to StrLen(APath) do StrCat(RPath, PChar(APath[Count]));
  949.    WD_NewShortPath := RPath;
  950.  
  951.    WriteLn(Apath,' -> ', RPath);
  952.  
  953.    END;
  954.  
  955. Procedure WD_NewShortHelp(APath : DirStrP2; MaxLen : Integer);
  956. VAR
  957.    Count : Integer;
  958.    Slash1 : Integer;
  959.    Slash2 : Integer;
  960.    Slash3 : Integer;
  961.    Slash4 : Integer;
  962.    NPath : DirStr;
  963. {   ShortHelp : DirStr;}
  964.    BPath : DirStr;
  965.    RLen : Integer;
  966.    HelpPChar : Array[0..1] of Char;
  967. BEGIN
  968.    IF StrLen(APath) < MaxLen THEN BEGIN
  969.       StrLCopy(ShortHelp,APath,SizeOf(ShortHelp));
  970.       Exit;
  971.       END;
  972.    IF StrLen(APath) <=3 THEN BEGIN
  973.       StrLCopy(ShortHelp,APath,SizeOf(ShortHelp));
  974.       Exit;
  975.       END;
  976.    Slash1 := -1;
  977.    Slash2 := -1;
  978.    Slash3 := -1;
  979.    Slash4 := -1;
  980.    {WriteLn('APath : ',APath);}
  981.    For Count := 0 to SizeOf(DirStr) DO ShortHelp[Count] := #0;
  982.    For Count := 0 to StrLen(APath) DO BEGIN
  983.       {
  984.       Write('Apath : ',APath[Count]);
  985.       WriteLn('--->', StrLen(APath),' :');
  986.       }
  987.       IF ((APath[Count] = '\') and (Slash2 = -1) and (Slash1 <> -1)) THEN Slash2 := Count
  988.       Else
  989.      IF ((APath[Count] = '\') and (Slash1 = -1)) THEN Slash1 := Count;
  990.       end;
  991.    IF ((Slash2 = -1)) THEN Slash2 := StrLen(Apath);
  992.    StrLCopy(ShortHelp,APath,Slash2+1);
  993.    StrCat(ShortHelp,'...');
  994.    For Count := StrLen(APath)-1-(MaxLen-StrLen(ShortHelp)-10) Downto 0 DO BEGIN
  995.    {
  996.       IF ((APath[Count] = '\') and (Slash3= -1) and (Slash4 <> -1)) THEN Slash3 := Count
  997.       else
  998.    }
  999.       IF ((APath[Count] = '\') and (Slash4 = -1)) THEN Slash4 := Count;
  1000.       end;
  1001.    IF ((Slash3 =-1)) THEN Slash3 := Slash4;
  1002.    IF ((Slash3 < Slash2)) THEN Slash3 := Slash2;
  1003.    FOR Count := Slash3 to StrLen(APath) do BEGIN
  1004.       HelpPChar[0] := APath[Count];
  1005.       HelpPChar[1] := #0;
  1006.       StrCat(ShortHelp, HelpPChar);
  1007.       end;
  1008.    END;
  1009.  
  1010. BEGIN
  1011. { Automatic registration of stream types }
  1012.    WD_RegisterStreamTypes;
  1013.    WaveCollect := New(PWaveCollection, Init(20,5));
  1014.    WaveDummyColl := New(PWaveCollection, Init(20,5));
  1015.    WaveCollect^.Duplicates := FALSE;
  1016.    WavePlayColl := New(PCollection, Init(20,5));
  1017.  
  1018.    WD_Scan4WorkDir;
  1019.  
  1020.    IF Exists(WF_DAT) THEN BEGIN
  1021.       WaveStream := New ( PBufStream, Init(WF_DAT,  stOpen, 512));
  1022.       WaveCollect := PWaveCollection(WaveStream^.Get);
  1023.  
  1024.       Dispose(WaveStream,Done);
  1025.       END
  1026.    ELSE BEGIN
  1027.       StrCopy(ShortMain,'Database not found - creating new database file.');
  1028.       BWCCMessageBox(0,ShortMain ,'Wicked Sounds for Windows: Note', mb_Ok+ mb_IconAsterisk);
  1029.       END;
  1030.  
  1031.    IF Exists(WF_CAS) THEN BEGIN
  1032.       WaveStream := New ( PBufStream, Init(WF_CAS,  stOpen, 512));
  1033.       WavePlayColl := PCollection(WaveStream^.Get);
  1034.       Dispose(WaveStream,Done);
  1035.       END
  1036.    END.
  1037.